diff --git a/NEWS b/NEWS index 194fc25dc..64811a97d 100644 --- a/NEWS +++ b/NEWS @@ -321,7 +321,7 @@ NEWS - user visible changes -*- outline -*- original version; note: their use will be adjusted where they don't match GCC's same options in later versions, including addition of -M and -MD -** New -std options: +** new -std options: gcos GCOS compatibility gcos-strict GCOS compatibility - strict @@ -330,6 +330,14 @@ NEWS - user visible changes -*- outline -*- dialect configuration options accompanying each specificity introduced by the dialect. +** new diagnostic format for errors: the diagnostics now print the source + code context with a left margin showing line numbers, configurable with + -fno-diagnostics-show-line-numbers, and possible to disable completely + with -fno-diagnostics-show-caret; + + the option -fdiagnostics-plain-output was added to request that diagnostic + output look as plain as possible and stay more stable over time + * Important Bugfixes: ** for dialects other than the GnuCOBOL default different reserved "alias" words diff --git a/build_aux/ChangeLog b/build_aux/ChangeLog index eb7b5e8ed..667d414b0 100644 --- a/build_aux/ChangeLog +++ b/build_aux/ChangeLog @@ -1,4 +1,10 @@ +2023-06-03 Simon Sobisch + + * config.sub, texinfo.tex: updated to recent versions from + https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ + * create_mingw_bindist.sh: fix check for MSYS2/mingw environments + 2023-02-06 Simon Sobisch * pre-inst-env.in: export COB_ON_CYGWIN for testsuite checks diff --git a/build_aux/config.sub b/build_aux/config.sub index baf1512b3..de4259e40 100755 --- a/build_aux/config.sub +++ b/build_aux/config.sub @@ -1,10 +1,10 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2022 Free Software Foundation, Inc. +# Copyright 1992-2023 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-09-17' +timestamp='2023-01-21' # 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 @@ -76,7 +76,7 @@ Report bugs and patches to ." version="\ GNU config.sub ($timestamp) -Copyright 1992-2022 Free Software Foundation, Inc. +Copyright 1992-2023 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." @@ -1075,7 +1075,7 @@ case $cpu-$vendor in pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) cpu=i586 ;; - pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*) + pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*) cpu=i686 ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) diff --git a/build_aux/create_mingw_bindist.sh b/build_aux/create_mingw_bindist.sh index 14ec89924..e47aeda26 100755 --- a/build_aux/create_mingw_bindist.sh +++ b/build_aux/create_mingw_bindist.sh @@ -1,7 +1,7 @@ #!/bin/bash # create_mingw_bindist.sh gnucobol # -# Copyright (C) 2016-2020, 2022 Free Software Foundation, Inc. +# Copyright (C) 2016-2020, 2022-2023 Free Software Foundation, Inc. # Written by Simon Sobisch # # This file is part of GnuCOBOL. @@ -25,7 +25,7 @@ # AND make sure EXTBUILDDIR exists with the right content. # Check we're in a MinGW environment -if test -d "$MSYSTEM_PREFIX/bin"; then +if test "x$MINGW_PREFIX" != "x" -a -d "$MSYSTEM_PREFIX/bin"; then MINGWDIR="$MSYSTEM_PREFIX" echo "generating binary ${MINGW_PREFIX:1} dist package..." elif test -d "/mingw/bin"; then diff --git a/build_aux/texinfo.tex b/build_aux/texinfo.tex index 8872e5e05..a32c84197 100644 --- a/build_aux/texinfo.tex +++ b/build_aux/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-04-09.08} +\def\texinfoversion{2023-03-27.21} % -% Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2023 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 @@ -58,12 +58,6 @@ \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}% @@ -241,9 +235,6 @@ % \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. @@ -317,16 +308,8 @@ \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.) +% is run several times, hiding the original value of \topmark. Hence, save +% \topmark at the beginning. % \newtoks\savedtopmark \newif\iftopmarksaved @@ -351,15 +334,9 @@ % \checkchapterpage % - % 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. - % - % 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). + % Make the heading and footing. \makeheadline and \makefootline + % use the contents of \headline and \footline. \def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars} - % \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi \global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}% \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi @@ -547,7 +524,7 @@ % ... 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}} +\long\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} % Check whether we're in the right environment: \def\checkenv#1{% @@ -608,6 +585,9 @@ % @/ allows a line break. \let\/=\allowbreak +% @- allows explicit insertion of hyphenation points +\def\-{\discretionary{\normaldash}{}{}}% + % @. is an end-of-sentence period. \def\.{.\spacefactor=\endofsentencespacefactor\space} @@ -617,21 +597,6 @@ % @? 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. @@ -725,32 +690,22 @@ \dimen2 = \ht\strutbox \advance\dimen2 by \dp\strutbox \ifdim\dimen0 > \dimen2 + % This is similar to the 'needspace' module in LaTeX. + % The first penalty allows a break if the end of the page is + % not too far away. Following penalties and skips are discarded. + % Otherwise, require at least \dimen0 of vertical space. % - % 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. + % (We used to use a \vtop to reserve space, but this had spacing issues + % when followed by a section heading, as it was not a "discardable item". + % This also has the benefit of providing glue before the page break if + % there isn't enough space.) + \vskip0pt plus \dimen0 + \penalty-100 + \vskip0pt plus -\dimen0 + \vskip \dimen0 \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 + \vskip -\dimen0 + \penalty0\relax % this hides the above glue from \safewhatsit and \dobreak \fi } @@ -1147,27 +1102,33 @@ % Output page labels information. % See PDF reference v.1.7 p.594, section 8.3.1. +% Page label ranges must be increasing. \ifpdf \def\pagelabels{% \def\title{0 << /P (T-) /S /D >>}% - \edef\roman{\the\romancount << /S /r >>}% - \edef\arabic{\the\arabiccount << /S /D >>}% % - % Page label ranges must be increasing. Remove any duplicates. - % (There is a slight chance of this being wrong if e.g. there is - % a @contents but no @titlepage, etc.) - % - \ifnum\romancount=0 \def\roman{}\fi - \ifnum\arabiccount=0 \def\title{}% - \else - \ifnum\romancount=\arabiccount \def\roman{}\fi - \fi - % - \ifnum\romancount<\arabiccount - \pdfcatalog{/PageLabels << /Nums [\title \roman \arabic ] >> }\relax + % support @contents at very end of document + \ifnum\contentsendcount=\pagecount + \ifnum\arabiccount<\romancount + \pdfcatalog{/PageLabels << /Nums + [\title + \the\arabiccount << /S /D >> + \the\romancount << /S /r >> + ] >> }\relax + \fi + % no contents in document + \else\ifnum\contentsendcount=0 + \pdfcatalog{/PageLabels << /Nums + [\title + \the\arabiccount << /S /D >> + ] >> }\relax \else - \pdfcatalog{/PageLabels << /Nums [\title \arabic \roman ] >> }\relax - \fi + \pdfcatalog{/PageLabels << /Nums + [\title + \the\romancount << /S /r >> + \the\contentsendcount << /S /D >> + ] >> }\relax + \fi\fi } \else \let\pagelabels\relax @@ -1176,6 +1137,8 @@ \newcount\pagecount \pagecount=0 \newcount\romancount \romancount=0 \newcount\arabiccount \arabiccount=0 +\newcount\contentsendcount \contentsendcount=0 + \ifpdf \let\ptxadvancepageno\advancepageno \def\advancepageno{% @@ -1239,13 +1202,17 @@ % % Set color, and create a mark which defines \thiscolor accordingly, % so that \makeheadline knows which color to restore. + \def\curcolor{0 0 0}% \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% + \ifx#1\curcolor\else + \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% + \domark + \pdfsetcolor{#1}% + \xdef\curcolor{#1}% + \fi } % - \def\maincolor{\rgbBlack} + \let\maincolor\rgbBlack \pdfsetcolor{\maincolor} \edef\thiscolor{\maincolor} \def\currentcolordefs{} @@ -1401,7 +1368,7 @@ % % by default, use black for everything. \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} + \let\linkcolor\rgbBlack \def\endlink{\setcolor{\maincolor}\pdfendlink} % % Adding outlines to PDF; macros for calculating structure of outlines @@ -1579,9 +1546,10 @@ \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% + \def\pdflink#1{\pdflinkpage{#1}{#1}}% + \def\pdflinkpage#1#2{% \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} - \setcolor{\linkcolor}#1\endlink} + \setcolor{\linkcolor}#2\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \else % non-pdf mode @@ -1828,10 +1796,11 @@ \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% + \def\pdflink#1{\pdflinkpage{#1}{#1}}% + \def\pdflinkpage#1#2{% \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}% - \setcolor{\linkcolor}#1\endlink} + \setcolor{\linkcolor}#2\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} % % @@ -2176,6 +2145,11 @@ \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% }% \fi\fi +% +% This is what gets called when #5 of \setfont is empty. +\let\cmap\gobble +% +% (end of cmaps) % Set the font macro #1 to the font named \fontprefix#2. @@ -2191,11 +2165,10 @@ \def\setfont#1#2#3#4#5{% \font#1=\fontprefix#2#3 scaled #4 \csname cmap#5\endcsname#1% + \ifx#2\ttshape\hyphenchar#1=-1 \fi + \ifx#2\ttbshape\hyphenchar#1=-1 \fi + \ifx#2\ttslshape\hyphenchar#1=-1 \fi } -% 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 @@ -2558,7 +2531,7 @@ \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}}\def\ttstylename{tt} +\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. @@ -2586,34 +2559,30 @@ \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. + +% \defineassignfonts{SIZE} - +% Define sequence \assignfontsSIZE, which switches between font sizes +% by redefining the meanings of \STYLEfont. (Just \STYLE additionally sets +% the current \fam for math mode.) % +\def\defineassignfonts#1{% + \expandafter\edef\csname assignfonts#1\endcsname{% + \let\noexpand\rmfont\csname #1rm\endcsname + \let\noexpand\itfont\csname #1it\endcsname + \let\noexpand\slfont\csname #1sl\endcsname + \let\noexpand\bffont\csname #1bf\endcsname + \let\noexpand\ttfont\csname #1tt\endcsname + \let\noexpand\smallcaps\csname #1sc\endcsname + \let\noexpand\sffont \csname #1sf\endcsname + \let\noexpand\ifont \csname #1i\endcsname + \let\noexpand\syfont \csname #1sy\endcsname + \let\noexpand\ttslfont\csname #1ttsl\endcsname + } +} \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 + \csname assignfonts#1\endcsname } \newif\ifrmisbold @@ -2637,12 +2606,21 @@ \csname\curfontstyle\endcsname }% +% Define the font-changing commands (all called \...fonts). +% 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. +% +% Note: The fonts used for \ifont are for "math italics" (\itfont is for +% italics in regular text). \syfont is also used in math mode only. +% \def\definefontsetatsize#1#2#3#4#5{% + \defineassignfonts{#1}% \expandafter\def\csname #1fonts\endcsname{% \def\curfontsize{#1}% \def\lsize{#2}\def\lllsize{#3}% \csname rmisbold#5\endcsname - \assignfonts{#1}% + \csname assignfonts#1\endcsname \resetmathfonts \setleading{#4}% }} @@ -2687,9 +2665,22 @@ % 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 } +% this property, we can check that font parameter. #1 is what to +% print if we are indeed using \tt; #2 is what to print otherwise. +\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} + + +% Check if internal flag is clear, i.e. has not been @set. +\def\ifflagclear#1#2#3{% + \expandafter\ifx\csname SET#1\endcsname\relax + #2\else#3\fi +} { \catcode`\'=\active @@ -2698,41 +2689,33 @@ \gdef\setcodequotes{\let`\codequoteleft \let'\codequoteright} \gdef\setregularquotes{\let`\lq \let'\rq} } +\setregularquotes -% 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. +% output for ' in @code +% in tt font hex 0D (undirected) or 27 (curly right quote) % \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 + \ifusingtt + {\ifflagclear{txicodequoteundirected}% + {\ifflagclear{codequoteundirected}% + {'}% + {\char"0D }}% + {\char"0D }}% + {'}% } -% -% 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. + +% output for ` in @code +% in tt font hex 12 (grave accent) or 60 (curly left quote) +% \relax disables Spanish ligatures ?` and !` of \tt font. % \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 + \ifusingtt + {\ifflagclear{txicodequotebacktick}% + {\ifflagclear{codequotebacktick}% + {\relax`}% + {\char"12 }}% + {\char"12 }}% + {\relax`}% } % Commands to set the quote options. @@ -2750,7 +2733,7 @@ \errmessage{Unknown @codequoteundirected value `\temp', must be on|off}% \fi\fi } -% + \parseargdef\codequotebacktick{% \def\temp{#1}% \ifx\temp\onword @@ -2765,6 +2748,11 @@ \fi\fi } +% Turn them on by default +\let\SETtxicodequoteundirected = t +\let\SETtxicodequotebacktick = t + + % [Knuth] pp. 380,381,391, disable Spanish ligatures ?` and !` of \tt font. \def\noligaturesquoteleft{\relax\lq} @@ -2779,15 +2767,16 @@ \def\dosmartslant#1#2{% \ifusingtt {{\ttsl #2}\let\next=\relax}% - {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}% + {\def\next{{#1#2}\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{% +% Output an italic correction unless the following character is such as +% not to need one. +\def\smartitaliccorrection{\futurelet\next\smartitaliccorrectionx} +\def\smartitaliccorrectionx{% \ifx\next,% \else\ifx\next-% \else\ifx\next.% @@ -2798,27 +2787,41 @@ \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} +% @cite unconditionally uses \sl with \smartitaliccorrection. +\def\cite#1{{\sl #1}\smartitaliccorrection} +% @var unconditionally uses \sl. This gives consistency for +% parameter names whether they are in @def, @table @code or a +% regular paragraph. +% To get ttsl font for @var when used in code context, @set txicodevaristt. +% The \null is to reset \spacefactor. \def\aftersmartic{} \def\var#1{% \let\saveaftersmartic = \aftersmartic \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% - \smartslanted{#1}% + % + \ifflagclear{txicodevaristt}% + {\def\varnext{{{\sl #1}}\smartitaliccorrection}}% + {\def\varnext{\smartslanted{#1}}}% + \varnext } +% To be removed after next release +\def\SETtxicodevaristt{}% @set txicodevaristt + \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 +% @r for roman font, used for code comment +\def\r#1{{% + \usenormaldash % get --, --- ligatures even if in @code + \defcharsdefault % in case on def line + \rm #1}} +{\catcode`-=\active \gdef\usenormaldash{\let-\normaldash}} + +% @sc, undocumented @ii. \def\sc#1{{\smallcaps#1}} % smallcaps font \def\ii#1{{\it #1}} % italic font @@ -2829,12 +2832,8 @@ % @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 = `- } +\newif\iffrenchspacing +\frenchspacingfalse % 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 @@ -2842,21 +2841,45 @@ % \catcode`@=11 \def\plainfrenchspacing{% - \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m - \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m - \def\endofsentencespacefactor{1000}% for @. and friends + \iffrenchspacing\else + \frenchspacingtrue + \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m + \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m + \def\endofsentencespacefactor{1000}% for @. and friends + \fi } \def\plainnonfrenchspacing{% - \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 - \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 - \def\endofsentencespacefactor{3000}% for @. and friends + \iffrenchspacing + \frenchspacingfalse + \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 + \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 + \def\endofsentencespacefactor{3000}% for @. and friends + \fi } \catcode`@=\other \def\endofsentencespacefactor{3000}% default +% @frenchspacing on|off says whether to put extra space after punctuation. +% +\def\onword{on} +\def\offword{off} +% +\let\frenchspacingsetting\plainnonfrenchspacing % used in output routine +\parseargdef\frenchspacing{% + \def\temp{#1}% + \ifx\temp\onword \let\frenchspacingsetting\plainfrenchspacing + \else\ifx\temp\offword \let\frenchspacingsetting\plainnonfrenchspacing + \else + \errhelp = \EMsimple + \errmessage{Unknown @frenchspacing option `\temp', must be on|off}% + \fi\fi + \frenchspacingsetting +} + + % @t, explicit typewriter. \def\t#1{% - {\tt \plainfrenchspacing #1}% + {\tt \defcharsdefault \plainfrenchspacing #1}% \null } @@ -2877,27 +2900,29 @@ % Switch to typewriter. \tt % - % But `\ ' produces the large typewriter interword space. + % `\ ' 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.) +% This is for LuaTeX: It is not sufficient to disable hyphenation at +% explicit dashes by setting `\hyphenchar` to -1. +\def\dashnobreak{% + \normaldash + \penalty 10000 } + +% We must turn on hyphenation at `-' and `_' in @code. % Otherwise, it is too hard to avoid overfull hboxes % in the Emacs manual, the Library manual, etc. +% We explicitly allow hyphenation at these characters +% using \discretionary. % -% 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. +% Hyphenation at - and hyphenation within words was turned off +% by default for the tt fonts using the \hyphenchar parameter of TeX. { \catcode`\-=\active \catcode`\_=\active \catcode`\'=\active \catcode`\`=\active @@ -2910,13 +2935,9 @@ \let-\codedash \let_\codeunder \else - \let-\normaldash + \let-\dashnobreak \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 } % @@ -2926,21 +2947,30 @@ % % Now, output a discretionary to allow a line break, unless % (a) the next character is a -, or - % (b) the preceding character is a -. + % (b) the preceding character is a -, or + % (c) we are at the start of the string. + % In both cases (b) and (c), \codedashnobreak should be set to \codedash. + % % 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 + \ifx\codedashnobreak\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 + \global\let\codedashnobreak= \next } } \def\normaldash{-} % -\def\codex #1{\tclose{#1}\endgroup} +\def\codex #1{\tclose{% + % Given -foo (with a single dash), we do not want to allow a break + % after the -. \codedashnobreak is set to the first character in + % @code. + \futurelet\codedashnobreak\relax + #1% +}\endgroup} \def\codeunder{% % this is all so @math{@code{var_name}+1} can work. In math mode, _ @@ -3187,7 +3217,7 @@ % definition of @key with no lozenge. % -\def\key#1{{\setregularquotes \nohyphenation \tt #1}\null} +\def\key#1{{\setregularquotes \tt #1}\null} % @clicksequence{File @click{} Open ...} \def\clicksequence#1{\begingroup #1\endgroup} @@ -3390,8 +3420,8 @@ \let\atchar=\@ % @{ @} @lbracechar{} @rbracechar{} all generate brace characters. -\def\lbracechar{{\ifmonospace\char123\else\ensuremath\lbrace\fi}} -\def\rbracechar{{\ifmonospace\char125\else\ensuremath\rbrace\fi}} +\def\lbracechar{{\ifusingtt{\char123}{\ensuremath\lbrace}}} +\def\rbracechar{{\ifusingtt{\char125}{\ensuremath\rbrace}}} \let\{=\lbracechar \let\}=\rbracechar @@ -3445,8 +3475,13 @@ % 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% + \ifx\curfontsize\smallword + % For footnotes and indices + \count255=\the\fam $\fam\count255 \scriptstyle A$% + \else + % For 11pt, we can use our lllsize. + \switchtolllsize A% + \fi \fi }% \vss @@ -3454,6 +3489,7 @@ \kern-.15em \TeX } +\def\smallword{small} % Some math mode symbols. Define \ensuremath to switch into math mode % unless we are already there. Expansion tricks may not be needed here, @@ -3532,7 +3568,7 @@ % @pounds{} is a sterling sign, which Knuth put in the CM italic font. % -\def\pounds{\ifmonospace{\ecfont\char"BF}\else{\it\$}\fi} +\def\pounds{{\ifusingtt{\ecfont\char"BF}{\it\$}}} % @euro{} comes from a separate font, depending on the current style. % We use the free feym* fonts from the eurosym package by Henrik @@ -3646,18 +3682,17 @@ % 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 + \ifusingtt + % 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}% \thisecfont } @@ -3673,7 +3708,10 @@ % @textdegree - the normal degrees sign. % -\def\textdegree{$^\circ$} +\def\textdegree{% + \ifmmode ^\circ + \else {\tcfont \char 176}% + \fi} % Laurent Siebenmann reports \Orb undefined with: % Textures 1.7.7 (preloaded format=plain 93.10.14) (68K) 16 APR 2004 02:38 @@ -3690,11 +3728,11 @@ % only change font for tt for correct kerning and to avoid using % \ecfont unless necessary. \def\quotedblleft{% - \ifmonospace{\ecfont\char"10}\else{\char"5C}\fi + \ifusingtt{{\ecfont\char"10}}{{\char"5C}}% } \def\quotedblright{% - \ifmonospace{\ecfont\char"11}\else{\char`\"}\fi + \ifusingtt{{\ecfont\char"11}}{{\char`\"}}% } @@ -3719,13 +3757,14 @@ want the contents after the title page.}}% \parseargdef\shorttitlepage{% - \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} + {\headingsoff \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% + \endgroup\page\hbox{}\page}\pageone} \envdef\titlepage{% % Open one extra group, as we want to close it in the middle of \Etitlepage. \begingroup \parindent=0pt \textfonts + \headingsoff % 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. @@ -3753,11 +3792,9 @@ % 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 + \pageone \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{% @@ -3824,15 +3861,16 @@ \newtoks\oddfootline % footline on odd pages % Now make \makeheadline and \makefootline in Plain TeX use those variables -\headline={{\textfonts\rm +\headline={{\textfonts\rm\frenchspacingsetting \ifchapterpage \ifodd\pageno\the\oddchapheadline\else\the\evenchapheadline\fi \else \ifodd\pageno\the\oddheadline\else\the\evenheadline\fi \fi}} -\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline - \else \the\evenfootline \fi}\HEADINGShook} +\footline={{\textfonts\rm\frenchspacingsetting + \ifodd\pageno \the\oddfootline \else \the\evenfootline \fi}% + \HEADINGShook} \let\HEADINGShook=\relax % Commands to set those variables. @@ -3925,46 +3963,37 @@ } \def\HEADINGSoff{{\globaldefs=1 \headingsoff}} % global setting -\HEADINGSoff % it's the default -% When we turn headings on, set the page number to 1. +% Set the page number to 1. \def\pageone{ \global\pageno=1 \global\arabiccount = \pagecount } +\let\contentsalignmacro = \chappager + +% \def\HEADINGSon{\HEADINGSdouble} % defined by \CHAPPAGon + % 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{% -\pageone -\HEADINGSdoublex -} -\let\contentsalignmacro = \chappager - -% For single-sided printing, chapter title goes across top left of page, -% page number on top right. -\def\HEADINGSsingle{% -\pageone -\HEADINGSsinglex -} -\def\HEADINGSon{\HEADINGSdouble} - -\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} +\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdouble} \let\HEADINGSdoubleafter=\HEADINGSafter -\def\HEADINGSdoublex{% +\def\HEADINGSdouble{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} -\global\evenchapheadline={\line{\folio\hfil}} +\global\evenchapheadline={\line{\folio\hfil\thistitle}} \global\oddchapheadline={\line{\hfil\folio}} \global\let\contentsalignmacro = \chapoddpage } -\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} -\def\HEADINGSsinglex{% +% For single-sided printing, chapter title goes across top left of page, +% page number on top right. +\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsingle} +\def\HEADINGSsingle{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} @@ -3976,7 +4005,6 @@ % for @setchapternewpage off \def\HEADINGSsinglechapoff{% -\pageone \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} @@ -4346,8 +4374,7 @@ % undo it ourselves. \def\headitemfont{\b}% for people to use in the template row; not changeable \def\headitem{% - \checkenv\multitable - \crcr + \crcr % must appear first \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 @@ -4432,7 +4459,7 @@ \message{conditionals,} -% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext, +% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotlatex, @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 @@ -4446,6 +4473,7 @@ \makecond{ifnotdocbook} \makecond{ifnothtml} \makecond{ifnotinfo} +\makecond{ifnotlatex} \makecond{ifnotplaintext} \makecond{ifnotxml} @@ -4458,10 +4486,12 @@ \def\ifdocbook{\doignore{ifdocbook}} \def\ifhtml{\doignore{ifhtml}} \def\ifinfo{\doignore{ifinfo}} +\def\iflatex{\doignore{iflatex}} \def\ifnottex{\doignore{ifnottex}} \def\ifplaintext{\doignore{ifplaintext}} \def\ifxml{\doignore{ifxml}} \def\ignore{\doignore{ignore}} +\def\latex{\doignore{latex}} \def\menu{\doignore{menu}} \def\xml{\doignore{xml}} @@ -4700,13 +4730,11 @@ % except not \outer, so it can be used within macros and \if's. \edef\newwrite{\makecsname{ptexnewwrite}} -% \newindex {foo} defines an index named IX. +% \newindex {IX} 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 @@ -4769,21 +4797,6 @@ \def\docodeindexxxx #1{\docind{\indexname}{#1}} -% Used for the aux, toc and index files to prevent expansion of Texinfo -% commands. -% -\def\atdummies{% - \definedummyletter\@% - \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 @@ -4799,110 +4812,91 @@ % \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. +% Used for the aux, toc and index files to prevent expansion of Texinfo +% commands. Most of the commands are controlled through the +% \ifdummies conditional. % -\def\definedummies{% +\def\atdummies{% + \dummiestrue % - \let\commondummyword\definedummyword - \let\commondummyletter\definedummyletter - \let\commondummyaccent\definedummyaccent - \commondummiesnofonts + \definedummyletter\@% + \definedummyletter\ % + \definedummyletter\{% + \definedummyletter\}% + \definedummyletter\&% % \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\ampchar - \definedummyword\atchar - \definedummyword\arrow - \definedummyword\backslashchar - \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 - % \definedummyword\subentry % % We want to disable all macros so that they are not expanded by \write. + \let\commondummyword\definedummyword \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. + \turnoffactive +} + +\newif\ifdummies +\newif\ifindexnofonts + +\def\commondummyletter#1{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \edef#1{% + \noexpand\ifindexnofonts + % empty expansion + \noexpand\else + \noexpand\ifdummies\string#1% + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} + +\def\commondummyaccent#1{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \edef#1{% + \noexpand\ifindexnofonts + \noexpand\expandafter % dispose of \else ... \fi + \noexpand\asis + \noexpand\else + \noexpand\ifdummies\string#1% + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} + +% Like \commondummyaccent but add a \space at the end of the dummy expansion +% #2 is the expansion used for \indexnofonts. #2 is always followed by +% \asis to remove a pair of following braces. +\def\commondummyword#1#2{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \expandafter\def\csname\string#1:ixnf\endcsname{#2\asis}% + \edef#1{% + \noexpand\ifindexnofonts + \noexpand\expandafter % dispose of \else ... \fi + \expandafter\noexpand\csname\string#1:ixnf\endcsname + \noexpand\else + \noexpand\ifdummies\string#1\space + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} +\def\jumptwofi#1\fi\fi{\fi\fi#1} + +% For \atdummies and \indexnofonts. \atdummies sets +% \dummiestrue and \indexnofonts sets \indexnofontstrue. +\def\definedummies{ + % @-sign is always an escape character when reading auxiliary files + \escapechar = `\@ + % \commondummyletter\!% \commondummyaccent\"% \commondummyaccent\'% @@ -4916,58 +4910,123 @@ \commondummyaccent\^% \commondummyaccent\`% \commondummyaccent\~% - \commondummyword\u - \commondummyword\v - \commondummyword\H - \commondummyword\dotaccent - \commondummyword\ogonek - \commondummyword\ringaccent - \commondummyword\tieaccent - \commondummyword\ubaraccent - \commondummyword\udotaccent - \commondummyword\dotless + % + % Control letters and accents. + \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 + \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 + \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 {}% + % + \commondummyword\AA {AA}% + \commondummyword\AE {AE}% + \commondummyword\DH {DZZ}% + \commondummyword\L {L}% + \commondummyword\O {O}% + \commondummyword\OE {OE}% + \commondummyword\TH {TH}% + \commondummyword\aa {aa}% + \commondummyword\ae {ae}% + \commondummyword\dh {dzz}% + \commondummyword\exclamdown {!}% + \commondummyword\l {l}% + \commondummyword\o {o}% + \commondummyword\oe {oe}% + \commondummyword\ordf {a}% + \commondummyword\ordm {o}% + \commondummyword\questiondown {?}% + \commondummyword\ss {ss}% + \commondummyword\th {th}% + % + \commondummyword\LaTeX {LaTeX}% + \commondummyword\TeX {TeX}% + % + % Assorted special characters. + \commondummyword\ampchar {\normalamp}% + \commondummyword\atchar {\@}% + \commondummyword\arrow {->}% + \commondummyword\backslashchar {\realbackslash}% + \commondummyword\bullet {bullet}% + \commondummyword\comma {,}% + \commondummyword\copyright {copyright}% + \commondummyword\dots {...}% + \commondummyword\enddots {...}% + \commondummyword\entrybreak {}% + \commondummyword\equiv {===}% + \commondummyword\error {error}% + \commondummyword\euro {euro}% + \commondummyword\expansion {==>}% + \commondummyword\geq {>=}% + \commondummyword\guillemetleft {<<}% + \commondummyword\guillemetright {>>}% + \commondummyword\guilsinglleft {<}% + \commondummyword\guilsinglright {>}% + \commondummyword\lbracechar {\{}% + \commondummyword\leq {<=}% + \commondummyword\mathopsup {sup}% + \commondummyword\minus {-}% + \commondummyword\pounds {pounds}% + \commondummyword\point {.}% + \commondummyword\print {-|}% + \commondummyword\quotedblbase {"}% + \commondummyword\quotedblleft {"}% + \commondummyword\quotedblright {"}% + \commondummyword\quoteleft {`}% + \commondummyword\quoteright {'}% + \commondummyword\quotesinglbase {,}% + \commondummyword\rbracechar {\}}% + \commondummyword\registeredsymbol {R}% + \commondummyword\result {=>}% + \commondummyword\sub {}% + \commondummyword\sup {}% + \commondummyword\textdegree {o}% } \let\indexlbrace\relax @@ -4985,25 +5044,24 @@ \catcode`\-=13 \catcode`\`=13 \gdef\indexnonalnumdisappear{% - \expandafter\ifx\csname SETtxiindexlquoteignore\endcsname\relax\else + \ifflagclear{txiindexlquoteignore}{}{% % @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 + \ifflagclear{txiindexbackslashignore}{}{% \backslashdisappear - \fi - % - \expandafter\ifx\csname SETtxiindexhyphenignore\endcsname\relax\else + }% + \ifflagclear{txiindexhyphenignore}{}{% \def-{}% - \fi - \expandafter\ifx\csname SETtxiindexlessthanignore\endcsname\relax\else + }% + \ifflagclear{txiindexlessthanignore}{}{% \def<{}% - \fi - \expandafter\ifx\csname SETtxiindexatsignignore\endcsname\relax\else + }% + \ifflagclear{txiindexatsignignore}{}{% \def\@{}% - \fi + }% } \gdef\indexnonalnumreappear{% @@ -5019,18 +5077,7 @@ % 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 + \indexnofontstrue % \def\ { }% \def\@{@}% @@ -5042,84 +5089,19 @@ \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}% - % - \let\do\indexnofontsdef - % - \do\LaTeX{LaTeX}% - \do\TeX{TeX}% - % - % Assorted special characters. - \do\atchar{@}% - \do\arrow{->}% - \do\bullet{bullet}% - \do\comma{,}% - \do\copyright{copyright}% - \do\dots{...}% - \do\enddots{...}% - \do\equiv{==}% - \do\error{error}% - \do\euro{euro}% - \do\expansion{==>}% - \do\geq{>=}% - \do\guillemetleft{<<}% - \do\guillemetright{>>}% - \do\guilsinglleft{<}% - \do\guilsinglright{>}% - \do\leq{<=}% - \do\lbracechar{\{}% - \do\minus{-}% - \do\point{.}% - \do\pounds{pounds}% - \do\print{-|}% - \do\quotedblbase{"}% - \do\quotedblleft{"}% - \do\quotedblright{"}% - \do\quoteleft{`}% - \do\quoteright{'}% - \do\quotesinglbase{,}% - \do\rbracechar{\}}% - \do\registeredsymbol{R}% - \do\result{=>}% - \do\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. % + \def\commondummyword##1{\let##1\asis}% \macrolist \let\value\indexnofontsvalue } -% Give the control sequence a definition that removes the {} that follows -% its use, e.g. @AA{} -> AA -\def\indexnofontsdef#1#2{\def#1##1{#2}}% - @@ -5250,7 +5232,10 @@ \xdef\trimmed{\segment}% \xdef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}% \xdef\indexsortkey{\trimmed}% - \ifx\indexsortkey\empty\xdef\indexsortkey{ }\fi + \ifx\indexsortkey\empty + \message{Empty index sort key near line \the\inputlineno}% + \xdef\indexsortkey{ }% + \fi }\fi % % Append to \fullindexsortkey. @@ -5295,9 +5280,7 @@ % \atdummies % - \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax\else - \escapeisbackslash - \fi + \ifflagclear{txiindexescapeisbackslash}{}{\escapeisbackslash}% % % For texindex which always views { and } as separators. \def\{{\lbracechar{}}% @@ -5481,9 +5464,9 @@ % 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{% - \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax + \ifflagclear{txiindexescapeisbackslash}{% \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1 - \expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax + \ifflagclear{txiskipindexfileswithbackslash}{% \errmessage{% ERROR: A sorted index file in an obsolete format was skipped. To fix this problem, please upgrade your version of 'texi2dvi' @@ -5499,15 +5482,15 @@ If you continue to have problems, deleting the index files and starting again might help (with 'rm \jobname.?? \jobname.??s')% }% - \else + }{% (Skipped sorted index file in obsolete format) - \fi + }% \else \begindoublecolumns \input \jobname.\indexname s \enddoublecolumns \fi - \else + }{% \begindoublecolumns \catcode`\\=0\relax % @@ -5517,7 +5500,7 @@ \catcode`\@=0\relax \input \jobname.\indexname s \enddoublecolumns - \fi + }% } % These macros are used by the sorted index file itself. @@ -5592,6 +5575,11 @@ \newdimen\entryrightmargin \entryrightmargin=0pt +% for PDF output, whether to make the text of the entry a link to the page +% number. set for @contents and @shortcontents where there is only one +% page number. +\newif\iflinkentrytext + % \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. @@ -5618,7 +5606,7 @@ } \def\entrybreak{\unskip\space\ignorespaces}% \def\doentry{% - % Save the text of the entry + % Save the text of the entry in \boxA \global\setbox\boxA=\hbox\bgroup \bgroup % Instead of the swallowed brace. \noindent @@ -5628,12 +5616,21 @@ % with catcodes occurring. } {\catcode`\@=11 +% #1 is the page number \gdef\finishentry#1{% - \egroup % end box A + \egroup % end \boxA \dimen@ = \wd\boxA % Length of text of entry + % add any leaders and page number to \boxA. \global\setbox\boxA=\hbox\bgroup - \unhbox\boxA - % #1 is the page number. + \ifpdforxetex + \iflinkentrytext + \pdflinkpage{#1}{\unhbox\boxA}% + \else + \unhbox\boxA + \fi + \else + \unhbox\boxA + \fi % % Get the width of the page numbers, and only use % leaders if they are present. @@ -5652,6 +5649,8 @@ \fi \fi \egroup % end \boxA + % + % now output \ifdim\wd\boxB = 0pt \noindent\unhbox\boxA\par \nobreak @@ -6351,7 +6350,7 @@ \fi } -\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname} +\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname\HEADINGSon} \def\CHAPPAGoff{% \global\let\contentsalignmacro = \chappager @@ -6368,7 +6367,7 @@ \global\let\pchapsepmacro=\chapoddpage \global\def\HEADINGSon{\HEADINGSdouble}} -\CHAPPAGon +\setchapternewpage on % \chapmacro - Chapter opening. % @@ -6381,6 +6380,16 @@ \def\Yappendixkeyword{Yappendix} \def\Yomitfromtockeyword{Yomitfromtoc} % +% +% Definitions for @thischapter. These can be overridden in translation +% files. +\def\thischapterAppendix{% + \putwordAppendix{} \thischapternum: \thischaptername} + +\def\thischapterChapter{% + \putwordChapter{} \thischapternum: \thischaptername} +% +% \def\chapmacro#1#2#3{% \expandafter\ifx\thisenv\titlepage\else \checkenv{}% chapters, etc., should not start inside an environment. @@ -6403,22 +6412,14 @@ \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}% + \let\noexpand\thischapter\noexpand\thischapterAppendix }% \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}% + \let\noexpand\thischapter\noexpand\thischapterChapter }% \fi\fi\fi % @@ -6504,6 +6505,12 @@ \def\subsubsecheadingskip{\subsecheadingskip} \def\subsubsecheadingbreak{\subsecheadingbreak} +% Definition for @thissection. This can be overridden in translation +% files. +\def\thissectionDef{% + \putwordSection{} \thissectionnum: \thissectionname} +% + % Print any size, any type, section title. % @@ -6545,11 +6552,7 @@ \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}% + \let\noexpand\thissection\noexpand\thissectionDef }% \fi \else @@ -6558,11 +6561,7 @@ \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}% + \let\noexpand\thissection\noexpand\thissectionDef }% \fi \fi\fi\fi @@ -6748,8 +6747,14 @@ \def\thistitle{}% no title in double-sided headings % Record where the Roman numerals started. \ifnum\romancount=0 \global\romancount=\pagecount \fi + \linkentrytexttrue } +% \raggedbottom in plain.tex hardcodes \topskip so override it +\catcode`\@=11 +\def\raggedbottom{\advance\topskip by 0pt plus60pt \r@ggedbottomtrue} +\catcode`\@=\other + % redefined for the two-volume lispref. We always output on % \jobname.toc even if this is redefined. % @@ -6812,12 +6817,8 @@ % Get ready to use Arabic numerals again \def\contentsendroman{% \lastnegativepageno = \pageno - \global\pageno = \savepageno - % - % If \romancount > \arabiccount, the contents are at the end of the - % document. Otherwise, advance where the Arabic numerals start for - % the page numbers. - \ifnum\romancount>\arabiccount\else\global\arabiccount=\pagecount\fi + \global\pageno=1 + \contentsendcount = \pagecount } % Typeset the label for a chapter or appendix for the short contents. @@ -6870,7 +6871,7 @@ % 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}% + \tocentry{\shortchaplabel{#2}\labelspace #1}{#4}% } % Appendices, in the main contents. @@ -6885,7 +6886,7 @@ % Unnumbered chapters. \def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}} -\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}} +\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{#4}} % Sections. \def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}} @@ -6917,24 +6918,24 @@ % Move the page numbers slightly to the right \advance\entryrightmargin by -0.05em \chapentryfonts - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup \nobreak\vskip .25\baselineskip plus.1\baselineskip } \def\dosecentry#1#2{\begingroup \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} \def\dosubsecentry#1#2{\begingroup \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} \def\dosubsubsecentry#1#2{\begingroup \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} % We use the same \entry macro as for the index entries. @@ -6943,9 +6944,6 @@ % 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} @@ -7090,19 +7088,25 @@ \newdimen\cartouter\newdimen\cartinner \newskip\normbskip\newskip\normpskip\newskip\normlskip - -\envdef\cartouche{% +\envparseargdef\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*. + % + % Set paragraph width for text inside cartouche. There are + % left and right margins of 3pt each plus two vrules 0.4pt each. \cartinner=\hsize \advance\cartinner by-\lskip \advance\cartinner by-\rskip + \advance\cartinner by -6.8pt + % + % For drawing top and bottom of cartouche. Each corner char + % adds 6pt and we take off the width of a rule to line up with the + % right boundary perfectly. \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 + \advance\cartouter by 11.6pt + % \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip % % If this cartouche directly follows a sectioning command, we need the @@ -7110,20 +7114,23 @@ % collide with the section heading. \ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi % - \setbox\groupbox=\vbox\bgroup + \setbox\groupbox=\vtop\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. + \hskip\lskip + \vrule\kern3pt + \vbox\bgroup + \hsize=\cartinner + \baselineskip=\normbskip + \lineskip=\normlskip + \parskip=\normpskip + \def\arg{#1}% + \ifx\arg\empty\else + \centerV{\hfil \bf #1 \hfil}% + \fi + \kern3pt + \vskip -\parskip } \def\Ecartouche{% \ifhmode\par\fi @@ -7277,22 +7284,6 @@ } \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 @@ -7390,8 +7381,9 @@ \endgroup % \def\setupverb{% - \tt % easiest (and conventionally used) font for verbatim + \tt \def\par{\leavevmode\endgraf}% + \parindent = 0pt \setcodequotes \tabeightspaces % Respect line breaks, @@ -7515,9 +7507,11 @@ % 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\copying{\checkenv{}\begingroup\macrobodyctxt\docopying} +{\catcode`\ =\other +\gdef\docopying#1@end copying{\endgroup\def\copyingtext{#1}} +} + \def\insertcopying{% \begingroup \parindent = 0pt % paragraph indentation looks wrong on title page @@ -7565,32 +7559,19 @@ \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} +% Called as \printdefunline \deffooheader{text} % \def\printdefunline#1#2{% \begingroup \plainfrenchspacing - % call \deffnheader: + % call \deffooheader: #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 + \penalty\defunpenalty % signal to \startdefun and \deffoox % Some of the @defun-type tags do not enable magic parentheses, % rendering the following check redundant. But we don't optimize. \checkparencounts @@ -7599,29 +7580,51 @@ \def\Edefun{\endgraf\medbreak} -% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn; -% the only thing remaining is to define \deffnheader. +% @defblock, @defline do not automatically create index entries +\envdef\defblock{% + \startdefun +} +\let\Edefblock\Edefun + +\def\defline{% + \doingtypefnfalse + \parseargusing\activeparens{\printdefunline\deflineheader}% +} +\def\deflineheader#1 #2 #3\endheader{% + \printdefname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% +} +\def\deftypeline{% + \doingtypefntrue + \parseargusing\activeparens{\printdefunline\deflineheader}% +} + +% \makedefun{deffoo} (\deffooheader parameters) { (\deffooheader expansion) } % +% Define \deffoo, \deffoox \Edeffoo and \deffooheader. \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% + \def#2{% + % First, check whether we are in the right environment: + \checkenv#1% + % + % As in \startdefun, 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 + % + \doingtypefnfalse % distinguish typed functions from all else + \parseargusing\activeparens{\printdefunline#3}% + }% + \def#3% definition of \deffooheader follows } \newif\ifdoingtypefn % doing typed function? @@ -7646,74 +7649,51 @@ \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}} } +\makedefun{deffn}#1 #2 #3\endheader{% + \doind{fn}{\code{#2}}% + \printdefname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% +} -% \deffngeneral {subind}category name args -% -\def\deffngeneral#1#2 #3 #4\endheader{% - \dosubind{fn}{\code{#3}}{#1}% - \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}% +% @defop category class name args +\makedefun{defop}#1 {\defopheaderx{#1\ \putwordon}} +\def\defopheaderx#1#2 #3 #4\endheader{% + \doind{fn}{\code{#3}\space\putwordon\ \code{#2}}% + \printdefname{#1\ \code{#2}}{}{#3}\magicamp\defunargs{#4\unskip}% } % Typed functions: % @deftypefn category type name args -\makedefun{deftypefn}{\deftypefngeneral{}} +\makedefun{deftypefn}#1 #2 #3 #4\endheader{% + \doind{fn}{\code{#3}}% + \doingtypefntrue + \printdefname{#1}{#2}{#3}\defunargs{#4\unskip}% +} % @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}% +\makedefun{deftypeop}#1 {\deftypeopheaderx{#1\ \putwordon}} +\def\deftypeopheaderx#1#2 #3 #4 #5\endheader{% + \doind{fn}{\code{#4}\space\putwordon\ \code{#1\ \code{#2}}}% \doingtypefntrue - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% + \printdefname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}% } % Typed variables: % @deftypevr category type var args -\makedefun{deftypevr}{\deftypecvgeneral{}} +\makedefun{deftypevr}#1 #2 #3 #4\endheader{% + \doind{vr}{\code{#3}}% + \printdefname{#1}{#2}{#3}\defunargs{#4\unskip}% +} % @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}% +\makedefun{deftypecv}#1 {\deftypecvheaderx{#1\ \putwordof}} +\def\deftypecvheaderx#1#2 #3 #4 #5\endheader{% + \doind{vr}{\code{#4}\space\putwordof\ \code{#2}}% + \printdefname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}% } % Untyped variables: @@ -7722,17 +7702,15 @@ \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 {} } +\makedefun{defcv}#1 {\defcvheaderx{#1\ \putwordof}} +\def\defcvheaderx#1#2 {\deftypecvheaderx{#1}#2 {} } % Types: % @deftp category name args \makedefun{deftp}#1 #2 #3\endheader{% \doind{tp}{\code{#2}}% - \defname{#1}{}{#2}\defunargs{#3\unskip}% + \printdefname{#1}{}{#2}\defunargs{#3\unskip}% } % Remaining @defun-like shortcuts: @@ -7743,19 +7721,19 @@ \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} +\makedefun{defmethod}{\defopheaderx\putwordMethodon} +\makedefun{deftypemethod}{\deftypeopheaderx\putwordMethodon} +\makedefun{defivar}{\defcvheaderx\putwordInstanceVariableof} +\makedefun{deftypeivar}{\deftypecvheaderx\putwordInstanceVariableof} -% \defname, which formats the name of the @def (not the args). +% \printdefname, 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{% +\def\printdefname#1#2#3{% \par % Get the values of \leftskip and \rightskip as they were outside the @def... \advance\leftskip by -\defbodyindent @@ -7765,9 +7743,7 @@ \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 + \ifflagclear{txideftypefnnl}{}{\rettypeownlinetrue}% \fi % % How we'll format the category name. Putting it in brackets helps @@ -7832,30 +7808,22 @@ \fi % no return type #3% output function name }% - {\rm\enskip}% hskip 0.5 em of \rmfont + \ifflagclear{txidefnamenospace}{% + {\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. -% +% Print arguments. Use slanted for @def*, typewriter for @deftype*. \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{{\setregularquotes\ttslanted{##1}}}% - #1% - \sl\hyphenchar\font=45 + \bgroup + \df \ifdoingtypefn \tt \else \sl \fi + \ifflagclear{txicodevaristt}{}% + {\def\var##1{{\setregularquotes \ttsl ##1}}}% + #1% + \egroup } % We want ()&[] to print specially on the defun line. @@ -7874,9 +7842,12 @@ % 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\defcharsdefault{% + \let(=\lparen \let)=\rparen + \let[=\lbrack \let]=\rbrack + \let& = \&% + } + \globaldefs=1 \defcharsdefault \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} @@ -7887,7 +7858,7 @@ % If we encounter &foo, then turn on ()-hacking afterwards \newif\ifampseen -\def\amprm#1 {\ampseentrue{\bf\ }} +\def\amprm#1 {\ampseentrue{\rm\ }} \def\parenfont{% \ifampseen @@ -8060,24 +8031,17 @@ \catcode`\_=\other \catcode`\|=\other \catcode`\~=\other - \passthroughcharstrue -} - -\def\scanargctxt{% used for copying and captions, not macros. - \scanctxt \catcode`\@=\other - \catcode`\\=\other \catcode`\^^M=\other + \catcode`\\=\active + \passthroughcharstrue } -\def\macrobodyctxt{% used for @macro definitions +\def\macrobodyctxt{% used for @macro definitions and @copying \scanctxt \catcode`\ =\other - \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other - \catcode`\^^M=\other - \usembodybackslash } % Used when scanning braced macro arguments. Note, however, that catcode @@ -8086,14 +8050,10 @@ \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 } @@ -8137,7 +8097,7 @@ \global\expandafter\let\csname ismacro.\the\macname\endcsname=1% \addtomacrolist{\the\macname}% \fi - \begingroup \macrobodyctxt + \begingroup \macrobodyctxt \usembodybackslash \ifrecursive \expandafter\parsermacbody \else \expandafter\parsemacbody \fi} @@ -8222,12 +8182,12 @@ % % 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. +% Set \macrobody to the body of the macro, and call \macrodef. % {\catcode`\ =\other\long\gdef\parsemacbody#1@end macro{% -\xdef\macrobody{\eatcr{#1}}\endgroup\defmacro}}% +\xdef\macrobody{\eatcr{#1}}\endgroup\macrodef}}% {\catcode`\ =\other\long\gdef\parsermacbody#1@end rmacro{% -\xdef\macrobody{\eatcr{#1}}\endgroup\defmacro}}% +\xdef\macrobody{\eatcr{#1}}\endgroup\macrodef}}% % Make @ a letter, so that we can make private-to-Texinfo macro names. \edef\texiatcatcode{\the\catcode`\@} @@ -8446,35 +8406,36 @@ % \xdef is used so that macro definitions will survive the file % they're defined in: @include reads the file inside a group. % -\def\defmacro{% +\def\macrodef{% \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. + \long\def\xeatspaces##1{##1}% + % We don't use \xeatspaces for single-argument macros, because we + % want to keep ends of lines. This definition removes \xeatspaces + % when \macrobody is expanded below. \else - \let\xeatspaces\relax % suppress expansion + \def\xeatspaces{\string\xeatspaces}% + % This expands \xeatspaces as a sequence of character tokens, which + % stops \scantokens inserting an extra space after the control sequence. \fi \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \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 + \endgroup \noexpand\scanmacro{\macrobody}}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\braceorline \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname##1{% - \egroup + \endgroup \noexpand\scanmacro{\macrobody}% }% \else % at most 9 @@ -8485,7 +8446,7 @@ % @MACNAME@@@ removes braces surrounding the argument list. % @MACNAME@@@@ scans the macro body with arguments substituted. \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\expandafter % This \expandafter skip any spaces after the \noexpand\macroargctxt % macro before we change the catcode of space. \noexpand\expandafter @@ -8499,7 +8460,7 @@ \expandafter\xdef \expandafter\expandafter \csname\the\macname @@@@\endcsname\paramlist{% - \egroup\noexpand\scanmacro{\macrobody}}% + \endgroup\noexpand\scanmacro{\macrobody}}% \else % 10 or more: \expandafter\xdef\csname\the\macname\endcsname{% \noexpand\getargvals@{\the\macname}{\argl}% @@ -8621,6 +8582,75 @@ \fi \macnamexxx} +% @linemacro + +\parseargdef\linemacro{% + \getargs{#1}% now \macname is the macname and \argl the arglist + \ifx\argl\empty + \paramno=0 + \let\hash\relax + \def\paramlist{\hash 1\endlinemacro}% + \else + \expandafter\linegetparamlist\argl;% + \fi + \begingroup \macrobodyctxt \usembodybackslash + \parselinemacrobody +} + +% Build up \paramlist which will be used as the parameter text for the macro. +% At the end it will be like "#1 #2 #3\endlinemacro". +\def\linegetparamlist#1;{% + \paramno=0\def\paramlist{}% + \let\hash\relax + \linegetparamlistxxx#1,;,% +} +\def\linegetparamlistxxx#1,{% + \if#1;\let\next=\linegetparamlistxxxx + \else \let\next=\linegetparamlistxxx + \advance\paramno by 1 + \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname + {\hash\the\paramno}% + \edef\paramlist{\paramlist\hash\the\paramno\space}% + \fi\next} +\def\linegetparamlistxxxx{% + \expandafter\fixparamlist\paramlist\fixparamlist +} +% Replace final space token +\def\fixparamlist#1 \fixparamlist{% + \def\paramlist{#1\endlinemacro}% +} + +% Read the body of the macro, replacing backslash-surrounded variables +% +{\catcode`\ =\other\long\gdef\parselinemacrobody#1@end linemacro{% +\xdef\macrobody{#1}% +\endgroup +\linemacrodef +}} + +% Make the definition +\def\linemacrodef{% + \let\hash=##% + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup + \noexpand\parsearg + \expandafter\noexpand\csname\the\macname @@\endcsname + } + \expandafter\xdef\csname\the\macname @@\endcsname##1{% + \egroup + \expandafter\noexpand + \csname\the\macname @@@\endcsname##1\noexpand\endlinemacro + } + \expandafter\expandafter + \expandafter\xdef + \expandafter\expandafter\csname\the\macname @@@\endcsname\paramlist{% + \newlinechar=13 % split \macrobody into lines + \noexpand\scantokens{\macrobody}% + } +} + + + % @alias. % We need some trickery to remove the optional spaces around the equal % sign. Make them active and then expand them all to nothing. @@ -8941,12 +8971,11 @@ % output the `[mynode]' via the macro below so it can be overridden. \xrefprintnodename\printedrefname % - \expandafter\ifx\csname SETtxiomitxrefpg\endcsname\relax - % But we always want a comma and a space: - ,\space - % + \ifflagclear{txiomitxrefpg}{% + % We always want a comma + ,% % output the `page 3'. - \turnoffactive \putwordpage\tie\refx{#1-pg}% + \turnoffactive \putpageref{#1}% % Add a , if xref followed by a space \if\space\noexpand\tokenafterxref ,% \else\ifx\ \tokenafterxref ,% @TAB @@ -8956,12 +8985,16 @@ \tokenafterxref ,% @NL \else\ifx\tie\tokenafterxref ,% @tie \fi\fi\fi\fi\fi\fi - \fi + }{}% \fi\fi \fi \endlink \endgroup} +% can be overridden in translation files +\def\putpageref#1{% + \space\putwordpage\tie\refx{#1-pg}} + % Output a cross-manual xref to #1. Used just above (twice). % % Only include the text "Section ``foo'' in" if the foo is neither @@ -9373,6 +9406,12 @@ \imagexxx #1,,,,,\finish \fi } + +% Approximate height of a line in the standard text font. +\newdimen\capheight +\setbox0=\vbox{\tenrm H} +\capheight=\ht0 + % % Arguments to @image: % #1 is (mandatory) image filename; we tack on .eps extension. @@ -9387,13 +9426,6 @@ \makevalueexpandable \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 here - \fi\fi - % - \ifimagevmode \medskip % Usually we'll have text after the image which will insert % \parskip glue, so insert it here too to equalize the space @@ -9402,17 +9434,20 @@ % % Place image in a \vtop for a top page margin that is (close to) correct, % as \topskip glue is relative to the first baseline. - \vtop\bgroup\hrule height 0pt\vskip-\parskip + \vtop\bgroup \kern -\capheight \vskip-\parskip \fi % - % Enter horizontal 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 \imageindent \fi + \ifx\centersub\centerV + % For @center @image, enter vertical mode and add vertical space + % Enter an extra \parskip because @center doesn't add space itself. + \vbox\bgroup\vskip\parskip\medskip\vskip\parskip + \else + % Enter horizontal 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. + \imageindent + \fi % % Output the image. \ifpdf @@ -9437,7 +9472,10 @@ \egroup \medskip % space after a standalone image \fi - \ifx\centersub\centerV \egroup \fi + \ifx\centersub\centerV % @center @image + \medskip + \egroup % close \vbox + \fi \endgroup} @@ -9604,8 +9642,8 @@ % \def\caption{\docaption\thiscaption} \def\shortcaption{\docaption\thisshortcaption} -\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption} -\def\defcaption#1#2{\egroup \def#1{#2}} +\def\docaption{\checkenv\float \bgroup\scanctxt\docaptionz} +\def\docaptionz#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. @@ -9894,12 +9932,10 @@ % For native Unicode handling (XeTeX and LuaTeX) \nativeunicodechardefs \else - % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX) + % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX). + % Since we already invoke \utfeightchardefs at the top level, + % making non-ascii chars active is sufficient. \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 @@ -9924,7 +9960,6 @@ \fi } -% emacs-page % A message to be logged when using a character that isn't available % the default font encoding (OT1). % @@ -9933,12 +9968,6 @@ % 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 @@ -9948,8 +9977,14 @@ \fi }} +\begingroup + +% Make non-ASCII characters active for defining the character definition +% macros. +\setnonasciicharscatcode\active + % Latin1 (ISO-8859-1) character definitions. -\def\latonechardefs{% +\gdef\latonechardefs{% \gdefchar^^a0{\tie} \gdefchar^^a1{\exclamdown} \gdefchar^^a2{{\tcfont \char162}} % cent @@ -10054,7 +10089,7 @@ } % Latin9 (ISO-8859-15) encoding character definitions. -\def\latninechardefs{% +\gdef\latninechardefs{% % Encoding is almost identical to Latin1. \latonechardefs % @@ -10069,7 +10104,7 @@ } % Latin2 (ISO-8859-2) character definitions. -\def\lattwochardefs{% +\gdef\lattwochardefs{% \gdefchar^^a0{\tie} \gdefchar^^a1{\ogonek{A}} \gdefchar^^a2{\u{}} @@ -10087,7 +10122,7 @@ \gdefchar^^ae{\v Z} \gdefchar^^af{\dotaccent Z} % - \gdefchar^^b0{\textdegree{}} + \gdefchar^^b0{\textdegree} \gdefchar^^b1{\ogonek{a}} \gdefchar^^b2{\ogonek{ }} \gdefchar^^b3{\l} @@ -10173,6 +10208,8 @@ \gdefchar^^ff{\dotaccent{}} } +\endgroup % active chars + % UTF-8 character definitions. % % This code to support UTF-8 is based on LaTeX's utf8.def, with some @@ -10324,9 +10361,9 @@ % Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp % to the corresponding UTF-8 sequence. \gdef\parseXMLCharref{% - \ifnum\countUTFz < "A0\relax + \ifnum\countUTFz < "20\relax \errhelp = \EMsimple - \errmessage{Cannot define Unicode char value < 00A0}% + \errmessage{Cannot define Unicode char value < 0020}% \else\ifnum\countUTFz < "800\relax \parseUTFviiiA,% \parseUTFviiiB C\UTFviiiTwoOctetsName.,% @@ -10396,6 +10433,103 @@ % least make most of the characters not bomb out. % \def\unicodechardefs{% + \DeclareUnicodeCharacter{0020}{ } % space + \DeclareUnicodeCharacter{0021}{\char"21 }% % space to terminate number + \DeclareUnicodeCharacter{0022}{\char"22 }% + \DeclareUnicodeCharacter{0023}{\char"23 }% + \DeclareUnicodeCharacter{0024}{\char"24 }% + \DeclareUnicodeCharacter{0025}{\char"25 }% + \DeclareUnicodeCharacter{0026}{\char"26 }% + \DeclareUnicodeCharacter{0027}{\char"27 }% + \DeclareUnicodeCharacter{0028}{\char"28 }% + \DeclareUnicodeCharacter{0029}{\char"29 }% + \DeclareUnicodeCharacter{002A}{\char"2A }% + \DeclareUnicodeCharacter{002B}{\char"2B }% + \DeclareUnicodeCharacter{002C}{\char"2C }% + \DeclareUnicodeCharacter{002D}{\char"2D }% + \DeclareUnicodeCharacter{002E}{\char"2E }% + \DeclareUnicodeCharacter{002F}{\char"2F }% + \DeclareUnicodeCharacter{0030}{0}% + \DeclareUnicodeCharacter{0031}{1}% + \DeclareUnicodeCharacter{0032}{2}% + \DeclareUnicodeCharacter{0033}{3}% + \DeclareUnicodeCharacter{0034}{4}% + \DeclareUnicodeCharacter{0035}{5}% + \DeclareUnicodeCharacter{0036}{6}% + \DeclareUnicodeCharacter{0037}{7}% + \DeclareUnicodeCharacter{0038}{8}% + \DeclareUnicodeCharacter{0039}{9}% + \DeclareUnicodeCharacter{003A}{\char"3A }% + \DeclareUnicodeCharacter{003B}{\char"3B }% + \DeclareUnicodeCharacter{003C}{\char"3C }% + \DeclareUnicodeCharacter{003D}{\char"3D }% + \DeclareUnicodeCharacter{003E}{\char"3E }% + \DeclareUnicodeCharacter{003F}{\char"3F }% + \DeclareUnicodeCharacter{0040}{\char"40 }% + \DeclareUnicodeCharacter{0041}{A}% + \DeclareUnicodeCharacter{0042}{B}% + \DeclareUnicodeCharacter{0043}{C}% + \DeclareUnicodeCharacter{0044}{D}% + \DeclareUnicodeCharacter{0045}{E}% + \DeclareUnicodeCharacter{0046}{F}% + \DeclareUnicodeCharacter{0047}{G}% + \DeclareUnicodeCharacter{0048}{H}% + \DeclareUnicodeCharacter{0049}{I}% + \DeclareUnicodeCharacter{004A}{J}% + \DeclareUnicodeCharacter{004B}{K}% + \DeclareUnicodeCharacter{004C}{L}% + \DeclareUnicodeCharacter{004D}{M}% + \DeclareUnicodeCharacter{004E}{N}% + \DeclareUnicodeCharacter{004F}{O}% + \DeclareUnicodeCharacter{0050}{P}% + \DeclareUnicodeCharacter{0051}{Q}% + \DeclareUnicodeCharacter{0052}{R}% + \DeclareUnicodeCharacter{0053}{S}% + \DeclareUnicodeCharacter{0054}{T}% + \DeclareUnicodeCharacter{0055}{U}% + \DeclareUnicodeCharacter{0056}{V}% + \DeclareUnicodeCharacter{0057}{W}% + \DeclareUnicodeCharacter{0058}{X}% + \DeclareUnicodeCharacter{0059}{Y}% + \DeclareUnicodeCharacter{005A}{Z}% + \DeclareUnicodeCharacter{005B}{\char"5B }% + \DeclareUnicodeCharacter{005C}{\char"5C }% + \DeclareUnicodeCharacter{005D}{\char"5D }% + \DeclareUnicodeCharacter{005E}{\char"5E }% + \DeclareUnicodeCharacter{005F}{\char"5F }% + \DeclareUnicodeCharacter{0060}{\char"60 }% + \DeclareUnicodeCharacter{0061}{a}% + \DeclareUnicodeCharacter{0062}{b}% + \DeclareUnicodeCharacter{0063}{c}% + \DeclareUnicodeCharacter{0064}{d}% + \DeclareUnicodeCharacter{0065}{e}% + \DeclareUnicodeCharacter{0066}{f}% + \DeclareUnicodeCharacter{0067}{g}% + \DeclareUnicodeCharacter{0068}{h}% + \DeclareUnicodeCharacter{0069}{i}% + \DeclareUnicodeCharacter{006A}{j}% + \DeclareUnicodeCharacter{006B}{k}% + \DeclareUnicodeCharacter{006C}{l}% + \DeclareUnicodeCharacter{006D}{m}% + \DeclareUnicodeCharacter{006E}{n}% + \DeclareUnicodeCharacter{006F}{o}% + \DeclareUnicodeCharacter{0070}{p}% + \DeclareUnicodeCharacter{0071}{q}% + \DeclareUnicodeCharacter{0072}{r}% + \DeclareUnicodeCharacter{0073}{s}% + \DeclareUnicodeCharacter{0074}{t}% + \DeclareUnicodeCharacter{0075}{u}% + \DeclareUnicodeCharacter{0076}{v}% + \DeclareUnicodeCharacter{0077}{w}% + \DeclareUnicodeCharacter{0078}{x}% + \DeclareUnicodeCharacter{0079}{y}% + \DeclareUnicodeCharacter{007A}{z}% + \DeclareUnicodeCharacter{007B}{\char"7B }% + \DeclareUnicodeCharacter{007C}{\char"7C }% + \DeclareUnicodeCharacter{007D}{\char"7D }% + \DeclareUnicodeCharacter{007E}{\char"7E }% + % \DeclareUnicodeCharacter{007F}{} % DEL + % \DeclareUnicodeCharacter{00A0}{\tie}% \DeclareUnicodeCharacter{00A1}{\exclamdown}% \DeclareUnicodeCharacter{00A2}{{\tcfont \char162}}% 0242=cent @@ -10413,7 +10547,7 @@ \DeclareUnicodeCharacter{00AE}{\registeredsymbol{}}% \DeclareUnicodeCharacter{00AF}{\={ }}% % - \DeclareUnicodeCharacter{00B0}{\ringaccent{ }}% + \DeclareUnicodeCharacter{00B0}{\textdegree}% \DeclareUnicodeCharacter{00B1}{\ensuremath\pm}% \DeclareUnicodeCharacter{00B2}{$^2$}% \DeclareUnicodeCharacter{00B3}{$^3$}% @@ -10917,7 +11051,7 @@ % \DeclareUnicodeCharacter{20AC}{\euro{}}% % - \DeclareUnicodeCharacter{2192}{\expansion{}}% + \DeclareUnicodeCharacter{2192}{\arrow}% \DeclareUnicodeCharacter{21D2}{\result{}}% % % Mathematical symbols @@ -11080,24 +11214,26 @@ % provide a definition macro to replace/pass-through a Unicode character % \def\DeclareUnicodeCharacterNative#1#2{% - \catcode"#1=\active - \def\dodeclareunicodecharacternative##1##2##3{% + \ifnum"#1>"7F % only make non-ASCII chars active + \catcode"#1=\active + \def\dodeclareunicodecharacternative##1##2##3{% + \begingroup + \uccode`\~="##2\relax + \uppercase{\gdef~}{% + \ifpassthroughchars + ##1% + \else + ##3% + \fi + } + \endgroup + } \begingroup - \uccode`\~="##2\relax - \uppercase{\gdef~}{% - \ifpassthroughchars - ##1% - \else - ##3% - \fi - } + \uccode`\.="#1\relax + \uppercase{\def\UTFNativeTmp{.}}% + \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% \endgroup - } - \begingroup - \uccode`\.="#1\relax - \uppercase{\def\UTFNativeTmp{.}}% - \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% - \endgroup + \fi } % Native Unicode handling (XeTeX and LuaTeX) character replacing definition. @@ -11126,14 +11262,14 @@ \relax } -% Define all Unicode characters we know about. This makes UTF-8 the default -% input encoding and allows @U to work. +% Define all Unicode characters we know about \iftxinativeunicodecapable \nativeunicodechardefsatu \else \utfeightchardefs \fi + \message{formatting,} \newdimen\defaultparindent \defaultparindent = 15pt @@ -11180,13 +11316,9 @@ % \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 @@ -11276,7 +11408,7 @@ \textleading = 12.5pt % \internalpagesizes{160mm}{120mm}% - {\voffset}{\hoffset}% + {\voffset}{-11.4mm}% {\bindingoffset}{8pt}% {210mm}{148mm}% % @@ -11355,9 +11487,138 @@ \hfuzz = 1pt +\message{microtype,} + +% protrusion, from Thanh's protcode.tex. +\def\mtsetprotcode#1{% + \rpcode#1`\!=200 \rpcode#1`\,=700 \rpcode#1`\-=700 \rpcode#1`\.=700 + \rpcode#1`\;=500 \rpcode#1`\:=500 \rpcode#1`\?=200 + \rpcode#1`\'=700 + \rpcode#1 34=500 % '' + \rpcode#1 123=300 % -- + \rpcode#1 124=200 % --- + \rpcode#1`\)=50 \rpcode#1`\A=50 \rpcode#1`\F=50 \rpcode#1`\K=50 + \rpcode#1`\L=50 \rpcode#1`\T=50 \rpcode#1`\V=50 \rpcode#1`\W=50 + \rpcode#1`\X=50 \rpcode#1`\Y=50 \rpcode#1`\k=50 \rpcode#1`\r=50 + \rpcode#1`\t=50 \rpcode#1`\v=50 \rpcode#1`\w=50 \rpcode#1`\x=50 + \rpcode#1`\y=50 + % + \lpcode#1`\`=700 + \lpcode#1 92=500 % `` + \lpcode#1`\(=50 \lpcode#1`\A=50 \lpcode#1`\J=50 \lpcode#1`\T=50 + \lpcode#1`\V=50 \lpcode#1`\W=50 \lpcode#1`\X=50 \lpcode#1`\Y=50 + \lpcode#1`\v=50 \lpcode#1`\w=50 \lpcode#1`\x=50 \lpcode#1`\y=0 + % + \mtadjustprotcode#1\relax +} + +\newcount\countC +\def\mtadjustprotcode#1{% + \countC=0 + \loop + \ifcase\lpcode#1\countC\else + \mtadjustcp\lpcode#1\countC + \fi + \ifcase\rpcode#1\countC\else + \mtadjustcp\rpcode#1\countC + \fi + \advance\countC 1 + \ifnum\countC < 256 \repeat +} + +\newcount\countB +\def\mtadjustcp#1#2#3{% + \setbox\boxA=\hbox{% + \ifx#2\font\else#2\fi + \char#3}% + \countB=\wd\boxA + \multiply\countB #1#2#3\relax + \divide\countB \fontdimen6 #2\relax + #1#2#3=\countB\relax +} + +\ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\pdffontexpand#1 20 20 1 autoexpand\relax} + \else % TeX + \def\mtfontexpand#1{} + \fi + \else % LuaTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} + \fi +\else % XeTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{} +\fi + + +\newif\ifmicrotype + +\def\microtypeON{% + \microtypetrue + % + \ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \pdfadjustspacing=2 + \pdfprotrudechars=2 + \fi + \else % LuaTeX + \adjustspacing=2 + \protrudechars=2 + \fi + \else % XeTeX + \XeTeXprotrudechars=2 + \fi + % + \mtfontexpand\textrm + \mtfontexpand\textsl + \mtfontexpand\textbf +} + +\def\microtypeOFF{% + \microtypefalse + % + \ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \pdfadjustspacing=0 + \pdfprotrudechars=0 + \fi + \else % LuaTeX + \adjustspacing=0 + \protrudechars=0 + \fi + \else % XeTeX + \XeTeXprotrudechars=0 + \fi +} + +\microtypeOFF + +\parseargdef\microtype{% + \def\txiarg{#1}% + \ifx\txiarg\onword + \microtypeON + \else\ifx\txiarg\offword + \microtypeOFF + \else + \errhelp = \EMsimple + \errmessage{Unknown @microtype option `\txiarg', must be on|off}% + \fi\fi +} + + \message{and turning on texinfo input format.} +% Make UTF-8 the default encoding. +\documentencodingzzz{UTF-8} + \def^^L{\par} % remove \outer, so ^L can appear in an @comment +\catcode`\^^K = 10 % treat vertical tab as whitespace % DEL is a comment character, in case @c does not suffice. \catcode`\^^? = 14 @@ -11373,23 +11634,6 @@ \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. @@ -11435,23 +11679,32 @@ % Used sometimes to turn off (effectively) the active characters even after % parsing them. \def\turnoffactive{% - \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 \otherbackslash + \setregularquotes + \unsepspaces } -\catcode`\@=0 +% 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 \loadconf turn them back on. +\catcode`+=\other \catcode`\_=\other + % \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 @@ -11461,109 +11714,120 @@ % 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. +\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 - @setregularquotes - @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}% +% These are made active for url-breaking, so need +% active definitions as the normal characters. +\def\normaldot{.} +\def\normalquest{?} +\def\normalslash{/} + +% \newlinesloadsconf - call \loadconf as soon as possible in the +% file, e.g. at the first newline. +% +{\catcode`\^=7 +\catcode`\^^M=13 +\gdef\newlineloadsconf{% + \catcode`\^^M=13 % + \newlineloadsconfzz% +} +\gdef\newlineloadsconfzz#1^^M{% + \def\c{\loadconf\c}% + % Definition for the first newline read in the file + \def ^^M{\loadconf}% % In case the first line has a whole-line command on it - @let@originalparsearg@parsearg - @def@parsearg{@fixbackslash@originalparsearg} + \let\originalparsearg\parsearg% + \def\parsearg{\loadconf\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% +{\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=@comment - @let@parsearg@originalparsearg +% \loadconf gets called at the beginning of every Texinfo file. +% If texinfo.cnf is present on the system, read it. Useful for site-wide +% @afourpaper, etc. Not opening texinfo.cnf directly in texinfo.tex +% makes it possible to make a format file for Texinfo. +% +\gdef\loadconf{% + \relax % Terminate the filename if running as "tex '&texinfo' FILE.texi". + % + % Turn off the definitions that trigger \loadconf + \everyjobreset + \catcode13=5 % regular end of line + \enableemergencynewline + \let\c=\comment + \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. + \catcode`+=\active + \catcode`\_=\active % - @openin 1 texinfo.cnf - @ifeof 1 @else @input texinfo.cnf @fi - @closein 1 + \openin 1 texinfo.cnf + \ifeof 1 \else \input texinfo.cnf \fi + \closein 1 } +% Redefine some control sequences to be controlled by the \ifdummies +% and \ifindexnofonts switches. Do this at the end so that the control +% sequences are all defined. +\definedummies + + + + +\catcode`\@=0 + +% \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. + +@let\ = @ttbackslash + +% If in a .fmt file, print the version number. +% \eatinput stops the `\input texinfo' from showing up. +% After that, `\' should revert to printing a backslash. +% 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]}% + @global@let\ = @eatinput + @catcode`+=@active @catcode`@_=@active} + +{@catcode`@^=7 @catcode`@^^M=13% +@gdef@eatinput input texinfo#1^^M{@loadconf}} + +@def@everyjobreset{@ifx\@eatinput @let\ = @ttbackslash @fi} + +% \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{% + @turnoffactive + @let\=@ttbackslash + } +} % 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{&} @@ -11578,15 +11842,11 @@ @c Do this last of all since we use ` in the previous @catcode assignments. @catcode`@'=@active @catcode`@`=@active -@setregularquotes @c Local variables: @c eval: (add-hook 'before-save-hook 'time-stamp nil t) @c time-stamp-pattern: "texinfoversion{%Y-%02m-%02d.%02H}" -@c page-delimiter: "^\\\\message\\|emacs-page" +@c page-delimiter: "^\\\\message" @c End: -@c vim:sw=2: - -@enablebackslashhack - +@newlineloadsconf diff --git a/cobc/ChangeLog b/cobc/ChangeLog index cf9ce9ecd..6383882f7 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,8 +1,44 @@ +2023-06-09 Simon Sobisch + + * error.c (print_error, diagnostics_show_caret): fix for C89 compat + * error.c (diagnostics_show_caret): trim trailing whitespace, + remove printing empty lines before/after, print EOF, changed format + +2023-06-02 Simon Sobisch + + * tree.h (cb_file), parser.y: organization and access_mode as enums + * typeck.c (cb_emit_sort_init, cb_emit_sort_using, cb_emit_sort_giving), + parser.y: extended syntax checks, distinguish MERGE and SORT within + diagnostics + * parser.y, typeck.c (cb_emit_sort_init): move all syntax checks from + code-emitter to parser + * tree.h (cb_statement), parser.y, typeck.c: drop flag_merge, + instead check by "statement == STMT_MERGE" + * parser.y (_close_option): parse UNIT/REEL WITH NO REWIND, + currently handled as if only UNIT/REEL would have been specified + +2023-06-01 Fabrice Le Fessant + + * flag.def (cb_diagnostics_show_line_numbers), error.c + (diagnostics_show_caret): new flag -fno-diagnostics-show-line-numbers + to disable printing of line numbers in carets + * cobc.c: new option -fdiagnostics-plain-output to make + output as plain as possible (disabling carets for example) + +2023-06-01 Simon Sobisch + + * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options + * typeck.c (cb_emit_sort_using, cb_emit_sort_giving): check if GIVING/USING + files have an active EXTFH handler and generate calls to sort functions + cob_file_sort_using_extfh / cob_file_sort_giving_extfh for those + 2023-05-31 Simon Sobisch * codegen.c (output_init_comment_and_source_ref) [NO_INIT_SOURCE_LOC]: option to skip generating the source location in DATA DIVISION + * parser.y (alphabet_name): add NATIVE (CB_COLSEQ_NATIVE), + change STANDARD_1 from CB_COLSEQ_NATIVE to CB_COLSEQ_ASCII 2023-05-30 Simon Sobisch @@ -11,7 +47,7 @@ 2023-05-28 Simon Sobisch * parser.y: allow expressions for screen related clauses - COL, LINE, LINES, SIZE, COLOR + COL, LINE, LINES, SIZE, COLOR, implementing FR #414 2023-05-26 Simon Sobisch @@ -227,6 +263,11 @@ of column 2 to fix terminal-format support and insert it before newlines are added to the beginning of the buffer +2023-02-21 Simon Sobisch + + * codegen.c, flag.def [COBC_HAS_CUTOFF_FLAG]: fix compile errors, + output -fif-cutoff to help when available + 2023-02-20 Nicolas Berthier * scanner.l, config.def: Add support for EBCDIC symbolic characters in @@ -235,11 +276,6 @@ * scanner.l, pplex.l: detect and issue a warning when EBCDIC symbolic character strings include extraneous separators -2023-02-21 Simon Sobisch - - * codegen.c, flag.def [COBC_HAS_CUTOFF_FLAG]: fix compile errors, - output -fif-cutoff to help when available - 2023-02-20 Fabrice Le Fessant * scanner.l (read_literal): refactor to use enum cb_literal_type @@ -247,6 +283,17 @@ * pplex.l: allow REPLACE between Gcos CONTROL DIVISION and the IDENTIFICATION DIVISION +2023-02-16 Fabrice Le Fessant + + * flag.def (cb_diagnostics_show_caret), error.c + (diagnostics_show_caret): new -fdiagnostics-show-caret (enabled by + default) to display source context of the error/warning, 2 lines + before and after the location + * error.c (cb_error_kind): replace all occurrences of a + error/warning/note string by a symbolic enum + * flag.def (cb_diagnostics_show_option), error.c: renamed from + cb_diagnostic_show_option to match the argument name + 2023-02-10 Simon Sobisch * cobc.c (clean_up_intermediates): fix missing move of temporary files diff --git a/cobc/cobc.c b/cobc/cobc.c index 336ac60bc..fe9095025 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -589,6 +589,7 @@ static const struct option long_options[] = { {"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= */ + {"fdiagnostics-plain-output", CB_NO_ARG, NULL, '/'}, {"Wall", CB_NO_ARG, NULL, 'W'}, {"Wextra", CB_NO_ARG, NULL, 'Y'}, /* this option used to be called -W */ #if 1 @@ -3459,6 +3460,12 @@ process_command_line (const int argc, char **argv) } break; + case '/': + /* -fdiagnostics-plain-output */ + cb_diagnostics_show_caret = 0 ; + cb_diagnostics_show_line_numbers = 0; + break; + case 'P': /* -P : Generate preproc listing */ if (cob_optarg) { diff --git a/cobc/codegen.c b/cobc/codegen.c index 8d89b298f..d7bf5f6e3 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2273,7 +2273,7 @@ output_emit_field (cb_tree x, const char *cmt) } else { output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, f->id); output_field (x); - output_local(";\t/* "); + output_local (";\t/* "); if (f->report_column > 0) { output_local ("col%3d ", f->report_column); } @@ -7839,8 +7839,9 @@ output_if (const struct cb_if *ip) 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) { + } else + if (ip->test == cb_false + && cb_flag_remove_unreachable) { output_line ("/* WHEN is always FALSE */"); } else if (CB_TREE_TAG (ip->test) == CB_TAG_BINARY_OP) { @@ -7867,7 +7868,8 @@ output_if (const struct cb_if *ip) } else { output_line ("/* WHEN */"); } - } else if (ip->test->source_line) { + } else + if (ip->test->source_line) { output_source_reference (ip->test, STMT_WHEN); } else { output_line ("/* WHEN */"); @@ -9281,6 +9283,7 @@ output_file_initialization (struct cb_file *f) } } + /* TODO: generate enum values and flags as text */ output_line ("%s%s->organization = %d;", CB_PREFIX_FILE, f->cname, f->organization); output_line ("%s%s->access_mode = %d;", CB_PREFIX_FILE, f->cname, diff --git a/cobc/error.c b/cobc/error.c index 09a62ca5d..61421b95d 100644 --- a/cobc/error.c +++ b/cobc/error.c @@ -32,6 +32,13 @@ #include "cobc.h" #include "tree.h" +enum cb_error_kind { + CB_KIND_ERROR, + CB_KIND_WARNING, + CB_KIND_NOTE, + CB_KIND_GENERAL +}; + static char *errnamebuff = NULL; static struct cb_label *last_section = NULL; static struct cb_label *last_paragraph = NULL; @@ -63,10 +70,79 @@ print_error_prefix (const char *file, int line, const char *prefix) } } +/* Display a context around the location of the error/warning, + only used if cb_diagnostics_show_caret is true + + Only display two lines before and after. No caret yet for the column as + we only have the line. Since we directly use the file, source is printed + before any REPLACE. */ +static void +diagnostics_show_caret (FILE *fd, const int line) +{ + #define CARET_MAX_COLS 73 + 5 + #define CARET_CONTEXT_LINES 2 + const int line_start = line > CARET_CONTEXT_LINES ? line - CARET_CONTEXT_LINES : 1; + const int line_end = line + CARET_CONTEXT_LINES; + const int max_pos = cb_diagnostics_show_line_numbers ? CARET_MAX_COLS - 5 : CARET_MAX_COLS; + char buffer[ CARET_MAX_COLS + 1 ]; + int line_pos = 1; + int char_pos = 0; + int c = 0; + while (c != EOF) { + buffer[char_pos] = c = fgetc (fd);; + if (c == '\n' || c == EOF || char_pos == max_pos) { + if (line_pos >= line_start) { + /* prefix */ + if (cb_diagnostics_show_line_numbers) { + fprintf (stderr, "%5d %c ", line_pos, + line == line_pos ? '>' : '|'); + } else { + fprintf (stderr, " %c ", + line == line_pos ? '>' : ' '); + } + /* drop trailing whitespace from buffer */ + while (char_pos >= 0 + && (buffer[char_pos] == ' ' + || buffer[char_pos] == '\t' + || buffer[char_pos] == '\r' + || buffer[char_pos] == '\n' + || buffer[char_pos] == EOF + || char_pos == max_pos)) { + buffer[char_pos--] = 0; + } + /* print it */ + fprintf (stderr, "%s%s\n", + buffer, + c == '\n' ? "" : + c == EOF ? "" : ".."); + } + if (line_pos++ >= line_end) { + break; + } + /* skip end of line too long */ + while (c != '\n' && c != EOF) { + c = fgetc (fd); + } + char_pos = buffer[0] = 0; + } else { + char_pos++; + } + } +} + static void -print_error (const char *file, int line, const char *prefix, +print_error (const char *file, int line, enum cb_error_kind kind, const char *fmt, va_list ap, const char *diagnostic_option) { + const char *prefix; + + switch( kind ){ + case CB_KIND_ERROR: prefix = _("error: "); break; + case CB_KIND_WARNING: prefix = _("warning: "); break; + case CB_KIND_NOTE: prefix = _("note: "); break; + case CB_KIND_GENERAL: prefix = ""; break; + } + if (!file) { file = cb_source_file; } @@ -119,12 +195,31 @@ print_error (const char *file, int line, const char *prefix, } cb_add_error_to_listing (file, line, prefix, errmsg); } + + if (cb_diagnostics_show_caret + && file != NULL + && strcmp (file, COB_DASH) != 0 + && line != 0) { + static const char *last_caret_file = NULL ; + static int last_caret_line = -1 ; + if (last_caret_file != file + || last_caret_line != line) { + FILE *fd = fopen (file, "r"); + if (fd) { + diagnostics_show_caret (fd, line); + fclose (fd); + } + /* remember last printed location to avoid reprinting it */ + last_caret_file = file; + last_caret_line = line; + } + } } static void cobc_too_many_errors (void) { - if (!cb_diagnostic_show_option) { + if (!cb_diagnostics_show_option) { fprintf (stderr, "cobc: %s\n", _("too many errors")); } else @@ -306,7 +401,7 @@ static char *warning_option_text (const enum cb_warn_opt opt, const enum cb_warn { const char *opt_name; - if (!cb_diagnostic_show_option) { + if (!cb_diagnostics_show_option) { return NULL; } switch (opt) { @@ -343,9 +438,9 @@ cb_warning_internal (const enum cb_warn_opt opt, const char *fmt, va_list ap) } if (pref != COBC_WARN_AS_ERROR) { - print_error (NULL, 0, _("warning: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, 0, _("error: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } if (sav_lst_file) { @@ -379,7 +474,7 @@ cb_error_always (const char *fmt, ...) cobc_in_repository = 0; va_start (ap, fmt); - print_error (NULL, 0, _("error: "), fmt, ap, NULL); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, NULL); va_end (ap); if (sav_lst_file) { @@ -405,12 +500,12 @@ cb_error_internal (const char *fmt, va_list ap) } if (!ignore_error) { - print_error (NULL, 0, _("error: "), fmt, ap, NULL); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, NULL); ret = COBC_WARN_AS_ERROR; } else if (pref == COBC_WARN_AS_ERROR) { - print_error (NULL, 0, _("error: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, 0, _("warning: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); } if (sav_lst_file) { @@ -447,7 +542,7 @@ cb_perror (const int config_error, const char *fmt, ...) } va_start (ap, fmt); - print_error (NULL, 0, "", fmt, ap, NULL); + print_error (NULL, 0, CB_KIND_GENERAL, fmt, ap, NULL); va_end (ap); @@ -472,9 +567,9 @@ cb_plex_warning (const enum cb_warn_opt opt, const size_t sline, const char *fmt va_start (ap, fmt); if (pref != COBC_WARN_AS_ERROR) { - print_error (NULL, cb_source_line + (int)sline, _("warning: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, cb_source_line + (int)sline, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, cb_source_line + (int)sline, _("error: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, cb_source_line + (int)sline, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } va_end (ap); @@ -496,7 +591,7 @@ cb_plex_error (const size_t sline, const char *fmt, ...) va_list ap; va_start (ap, fmt); - print_error (NULL, cb_source_line + (int)sline, ("error: "), fmt, ap, NULL); + print_error (NULL, cb_source_line + (int)sline, CB_KIND_ERROR, fmt, ap, NULL); va_end (ap); if (sav_lst_file) { @@ -628,7 +723,7 @@ cb_warning_x_internal (const enum cb_warn_opt opt, cb_tree x, const char *fmt, v } print_error (x->source_file, x->source_line, - pref == COBC_WARN_AS_ERROR ? _("error: ") : _("warning: "), + pref == COBC_WARN_AS_ERROR ? CB_KIND_ERROR : CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); if (sav_lst_file) { @@ -672,7 +767,7 @@ cb_warning_dialect_x (const enum cb_support tag, cb_tree x, const char *fmt, ... va_start (ap, fmt); print_error (x->source_file, x->source_line, - ret == COBC_WARN_AS_ERROR ? _("error: ") : _("warning: "), + ret == COBC_WARN_AS_ERROR ? CB_KIND_ERROR : CB_KIND_WARNING, fmt, ap, NULL); va_end (ap); @@ -725,10 +820,10 @@ cb_note_x (const enum cb_warn_opt opt, cb_tree x, const char *fmt, ...) listprint_suppress (); va_start (ap, fmt); if (opt != COB_WARNOPT_NONE) { - print_error (x->source_file, x->source_line, _("note: "), + print_error (x->source_file, x->source_line, CB_KIND_NOTE, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (x->source_file, x->source_line, _("note: "), + print_error (x->source_file, x->source_line, CB_KIND_NOTE, fmt, ap, NULL); } va_end (ap); @@ -752,10 +847,10 @@ cb_note (const enum cb_warn_opt opt, const int suppress_listing, const char *fmt } va_start (ap, fmt); if (opt != COB_WARNOPT_NONE) { - print_error (NULL, 0, _("note: "), + print_error (NULL, 0, CB_KIND_NOTE, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, 0, _("note: "), + print_error (NULL, 0, CB_KIND_NOTE, fmt, ap, NULL); } va_end (ap); @@ -776,13 +871,13 @@ cb_error_x_internal (cb_tree x, const char *fmt, va_list ap) } if (!ignore_error) { - print_error (x->source_file, x->source_line, _("error: "), + print_error (x->source_file, x->source_line, CB_KIND_ERROR, fmt, ap, NULL); } else if (pref == COBC_WARN_AS_ERROR) { - print_error (x->source_file, x->source_line, _("error: "), + print_error (x->source_file, x->source_line, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (x->source_file, x->source_line, _("warning: "), + print_error (x->source_file, x->source_line, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); ret = COBC_WARN_ENABLED; } diff --git a/cobc/flag.def b/cobc/flag.def index 80d96fe20..a98f48346 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -232,6 +232,12 @@ CB_FLAG (cb_listing_symbols, 1, "tsymbols", CB_FLAG (cb_listing_cmd, 1, "tcmd", _(" -ftcmd specify command line in listing")) -CB_FLAG_ON (cb_diagnostic_show_option, 1, "diagnostics-show-option", +CB_FLAG_ON (cb_diagnostics_show_option, 1, "diagnostics-show-option", _(" -fno-diagnostics-show-option\tsuppress output of option that directly\n" " controls the diagnostic")) + +CB_FLAG_ON (cb_diagnostics_show_caret, 1, "diagnostics-show-caret", + _(" -fno-diagnostics-show-caret\tdo not display source context on warning/error diagnostic")) + +CB_FLAG_ON (cb_diagnostics_show_line_numbers, 1, "diagnostics-show-line-numbers", + _(" -fno-diagnostics-show-line-numbers\tsuppress display of line numbers in diagnostics")) diff --git a/cobc/help.c b/cobc/help.c index 0cde1f29d..4f4dda32b 100644 --- a/cobc/help.c +++ b/cobc/help.c @@ -162,6 +162,7 @@ cobc_print_usage_warnings (void) #undef CB_ONWARNDEF #undef CB_NOWARNDEF #undef CB_ERRWARNDEF + puts (_(" -fdiagnostics-plain-output\tmake diagnostic output as plain as possible")); puts (_(" -Werror treat all warnings as errors")); puts (_(" -Wno-error don't treat warnings as errors")); puts (_(" -Werror= treat specified as error")); diff --git a/cobc/parser.y b/cobc/parser.y index 416b38b44..3e440a6e5 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -697,7 +697,7 @@ 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")); + cb_error (_("USE statement invalid for SD file")); } if (fileptr->flag_global) { newptr = cobc_parse_malloc (sizeof(struct cb_file)); @@ -1604,7 +1604,7 @@ setup_prototype (cb_tree prototype_name, cb_tree ext_name, } static void -error_if_record_delimiter_incompatible (const int organization, +error_if_record_delimiter_incompatible (const enum cob_file_org organization, const char *organization_name) { int is_compatible; @@ -5768,11 +5768,15 @@ alphabet_name: $$ = cb_error_node; } } -| STANDARD_1 +| NATIVE { $$ = build_colseq (CB_COLSEQ_NATIVE); } -| STANDARD_2 +| STANDARD_1 /* CHECKME: shouldn't that be 7-bit? */ + { + $$ = build_colseq (CB_COLSEQ_ASCII); + } +| STANDARD_2 /* CHECKME: shouldn't that be 7-bit? */ { $$ = build_colseq (CB_COLSEQ_ASCII); } @@ -12854,10 +12858,11 @@ close_files: _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); } +| reel_or_unit { $$ = cb_int (COB_CLOSE_UNIT); } +| reel_or_unit _for REMOVAL { $$ = cb_int (COB_CLOSE_UNIT_REMOVAL); } +| reel_or_unit _with NO REWIND { $$ = cb_int (COB_CLOSE_UNIT); } /* PENDING */ ; close_window: @@ -15097,9 +15102,8 @@ merge_statement: MERGE { begin_statement (STMT_MERGE, 0); - current_statement->flag_merge = 1; } - sort_body + sort_merge_body ; @@ -16300,10 +16304,10 @@ sort_statement: { begin_statement (STMT_SORT, 0); } - sort_body + sort_merge_body ; -sort_body: +sort_merge_body: table_identifier /* may reference a file or a table */ _sort_key_list _sort_duplicates _sort_collating { @@ -16312,8 +16316,12 @@ sort_body: $$ = NULL; if (CB_VALID_TREE (x)) { if ($2 == NULL || CB_VALUE ($2) == NULL) { + if (current_statement->statement == STMT_MERGE) { + cb_error (_("MERGE requires KEY phrase")); + $2 = cb_error_node; + } else if (CB_FILE_P (x)) { - cb_error (_("file sort requires KEY phrase")); + cb_error (_("file SORT requires KEY phrase")); $2 = cb_error_node; } else { struct cb_field *f = CB_FIELD_PTR (x); @@ -16341,6 +16349,9 @@ sort_body: $2 = cb_error_node; } } + } else if (CB_FILE_P (x) && CB_FILE (x)->organization != COB_ORG_SORT) { + cb_error_x (x, _("must be an SD filename")); + $2 = cb_error_node; } if (CB_VALID_TREE ($2)) { cb_emit_sort_init ($1, $2, alphanumeric_collation, national_collation); @@ -16399,7 +16410,11 @@ sort_input: /* empty */ { if ($0 && CB_FILE_P (cb_ref ($0))) { - cb_error (_("file sort requires USING or INPUT PROCEDURE")); + if (current_statement->statement == STMT_MERGE) { + cb_error (_("MERGE requires USING files")); + } else { + cb_error (_("file SORT requires USING or INPUT PROCEDURE")); + } } } | USING file_name_list @@ -16417,7 +16432,7 @@ sort_input: if ($0) { if (!CB_FILE_P (cb_ref ($0))) { cb_error (_("INPUT PROCEDURE invalid with table SORT")); - } else if (current_statement->flag_merge) { + } else if (current_statement->statement == STMT_MERGE) { cb_error (_("INPUT PROCEDURE invalid with MERGE")); } else { cb_emit_sort_input ($4); @@ -16431,7 +16446,11 @@ sort_output: /* empty */ { if ($-1 && CB_FILE_P (cb_ref ($-1))) { - cb_error (_("file sort requires GIVING or OUTPUT PROCEDURE")); + if (current_statement->statement == STMT_MERGE) { + cb_error (_("MERGE requires GIVING or OUTPUT PROCEDURE")); + } else { + cb_error (_("file SORT requires GIVING or OUTPUT PROCEDURE")); + } } } | GIVING file_name_list @@ -16847,7 +16866,7 @@ unlock_body: 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")); + _("UNLOCK invalid for SD files")); } else { cb_emit_unlock ($1); } @@ -18709,7 +18728,7 @@ _reference: single_reference_list: single_reference { $$ = CB_LIST_INIT ($1); } -| single_reference_list single_reference{ $$ = cb_list_add ($1, $2); } +| single_reference_list single_reference { $$ = cb_list_add ($1, $2); } ; single_reference: diff --git a/cobc/scanner.l b/cobc/scanner.l index 4010f33af..7b425d96b 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -370,7 +370,7 @@ AREA_A "#AREA_A"\n "FUNCTION" { if (cobc_in_repository || cobc_cs_check == CB_CS_EXIT) { yylval = NULL; - RETURN_TOK (FUNCTION); + RETURN_TOK (FUNCTION); } BEGIN FUNCTION_STATE; } @@ -936,8 +936,8 @@ H#[0-9A-Za-z]+ { /* 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) + otherwise return 2 (!) WORD tokens (by adding a queue + of tokens to be returned) */ if (cobc_in_procedure) { /* unput characters */ diff --git a/cobc/tree.h b/cobc/tree.h index 36f749de4..df31751a5 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1130,8 +1130,8 @@ struct cb_file { 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 */ + enum cob_file_org organization; /* ORGANIZATION */ + enum cob_file_access_mode access_mode; /* ACCESS MODE */ int lock_mode; /* LOCK MODE */ int special; /* Special file */ int same_clause; /* SAME clause */ @@ -1519,7 +1519,6 @@ struct cb_statement { 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 */ }; diff --git a/cobc/typeck.c b/cobc/typeck.c index f05823821..f9d465fba 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -13570,7 +13570,7 @@ cb_emit_set_last_exception_to_off (void) cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception", cb_int0)); } -/* SORT statement */ +/* SORT + MERGE statements */ void cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) @@ -13592,7 +13592,7 @@ cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) } /* note: the reference to the program's collation, - if not explicit specified in SORT is done within libcob */ + if not explicit specified in SORT/MERGE, is done within libcob */ if (col == NULL) { col = cb_null; } else { @@ -13607,28 +13607,30 @@ cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) COB_UNUSED (nat_col); if (CB_FILE_P (rtree)) { - if (CB_FILE (rtree)->organization != COB_ORG_SORT) { - cb_error_x (name, _("invalid SORT filename")); - } + cb_tree sort_return; + const struct cb_file *sd_file = CB_FILE (rtree); 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)); + sort_return = CB_BUILD_CAST_ADDRESS (current_program->cb_sort_return); } 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)); - + sort_return = cb_null; + } + cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", rtree, + cb_int ((int)cb_list_length (keys)), col, + sort_return, sd_file->file_status)); + if (current_statement->statement == STMT_MERGE) { + /* note: this function can be used later to set more options */ + cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_options", rtree, + cb_build_string (cobc_parse_strdup ("M"), 1))); } /* TODO: pass key-specific collation to libcob */ for (l = keys; l; l = CB_CHAIN (l)) { + cb_tree fref = CB_VALUE (l); cb_emit (CB_BUILD_FUNCALL_4 ("cob_file_sort_init_key", rtree, - CB_VALUE (l), + fref, CB_PURPOSE (l), - cb_int (CB_FIELD_PTR (CB_VALUE(l))->offset))); + cb_int (CB_FIELD_PTR (fref)->offset))); } } else { struct cb_field * const fr = CB_FIELD (rtree); @@ -13667,13 +13669,21 @@ cb_emit_sort_using (cb_tree file, cb_tree l) } /* LCOV_EXCL_STOP */ for (; l; l = CB_CHAIN (l)) { - cb_tree use_file = cb_ref (CB_VALUE (l)); - if (CB_FILE (use_file)->organization == COB_ORG_SORT) { + cb_tree use_ref = cb_ref (CB_VALUE (l)); + const struct cb_file *use_file = CB_FILE (use_ref); + if (use_file->organization == COB_ORG_SORT) { cb_error_x (CB_TREE (current_statement), - _("invalid SORT USING parameter")); + _("invalid %s parameter"), + current_statement->statement == STMT_MERGE ? + "MERGE USING" : "SORT USING"); + } + if (use_file->extfh) { + cb_emit (CB_BUILD_FUNCALL_3 ("cob_file_sort_using_extfh", + rtree, use_ref, use_file->extfh)); + } else { + cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using", + rtree, use_ref)); } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using", - rtree, use_file)); } } @@ -13688,40 +13698,55 @@ cb_emit_sort_input (cb_tree proc) } void -cb_emit_sort_giving (cb_tree file, cb_tree l) +cb_emit_sort_giving (cb_tree sd_file, cb_tree l) { cb_tree p; - int listlen; + cb_tree extfh_list = NULL; + int has_extfh = 0; + const char *file_sort_giving_func; 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) { + /* TODO: let parser create a list of files, not their references */ + const struct cb_file *giving_file = CB_FILE (cb_ref (CB_VALUE (p))); + if (giving_file->organization == COB_ORG_SORT) { cb_error_x (CB_TREE (current_statement), - _("invalid SORT GIVING parameter")); + _("invalid %s parameter"), + current_statement->statement == STMT_MERGE ? + "MERGE GIVING" : "SORT GIVING"); + } + extfh_list = cb_list_add (extfh_list, CB_TREE (giving_file)); + cb_list_add (extfh_list, giving_file->extfh); + has_extfh += (giving_file->extfh != NULL); } - p = cb_ref (file); + p = cb_ref (sd_file); /* LCOV_EXCL_START */ if (p == cb_error_node) { cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_sort_giving", "file"); + "cb_emit_sort_giving", "sd_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; + if (has_extfh) { + file_sort_giving_func = "cob_file_sort_giving_extfh"; + l = extfh_list; + } else { + file_sort_giving_func = "cob_file_sort_giving"; + } + p = CB_BUILD_FUNCALL_2 (file_sort_giving_func, p, l); + CB_FUNCALL(p)->varcnt = cb_list_length (l); 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) { + if (current_program->flag_debugging + && !current_statement->flag_in_debug) { + if (current_statement->statement == STMT_MERGE) { cb_emit (cb_build_debug (cb_debug_contents, "MERGE OUTPUT", NULL)); } else { diff --git a/libcob/ChangeLog b/libcob/ChangeLog index fd9e693a5..aed2dea0f 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,38 @@ +2023-06-03 Simon Sobisch + + * Makefile.am (libcob_la_LDFLAGS): updated version-info - ABI fixed for 3.2 + +2023-06-02 Simon Sobisch + + * common.h (cob_file_org, cob_file_access_mode): changed defines to enums + * fileio.c (cob_findkey_attr): extracted identical logic from cob_findkey, + indexed_findkey and bdb_findkey; + dropping the later two and set mapkey after calling it + * fileio.c (cob_file_sort_using, cob_file_sort_giving): raise + COB_EC_SORT_MERGE_FILE_OPEN when applicable + * fileio.c (cob_copy_check, cob_file_sort_submit, cob_file_sort_retrieve): + pass most matching argument type instead of the structures containing it + * fileio.c (cob_file_sort_using_extfh, cob_file_sort_giving_extfh), + common.h: new functions, using EXTFH functions to read/write the data + * fileio.c (update_fcd_to_file): set exception for non-digit returns, + handle EOP flag (only usable if the internal EXTFH function was used) + * fileio.c (cob_extfh_close): handle close options, most important: + CLOSE REEL (as that does not actually close the file) + * fileio.c (EXTFH3): handle OP_CLOSE_REEL to leave the file open + * fileio.c (EXTFH3): handle "read direct" opcodes for now as "read random" + * fileio.c (EXTFH3): setup intermediate record only for WRITE/REWRITE as + it isn't used otherwise + * fileio.c (update_key_from_fcd): extracted from EXTFH3 + * fileio.c (update_key_from_fcd): only handle (logical) key field as split + keys are all handled in io functions and otherwise not found there + * fileio.c (find_fcd, cob_extfh_close): specify free handling by parameter, + new value "-1" is used if FCD was created by ADDRESS OF FH--FCD, + otherwise it is lost on first CLOSE + * fileio.c: disable setting of record min/max size outside of OPEN, + disable setting of record size in some places + + 2023-06-01 Simon Sobisch * fileio.c: minor refactoring for SORT related functions, @@ -10,6 +44,9 @@ where OPEN OUTPUT was not successful * fileio.c (cob_file_sort_giving): skip GIVING file on WRITE errors, early exit if no GIVING file left + * fileio.c (cobsort): new attribute flag_merge + * fileio.c (cob_file_sort_options), common.h: new function to pass more + options, so far only used to set flag_merge 2023-05-30 Simon Sobisch diff --git a/libcob/Makefile.am b/libcob/Makefile.am index 1f388c6a2..ce5a4a5cc 100644 --- a/libcob/Makefile.am +++ b/libcob/Makefile.am @@ -1,7 +1,7 @@ # # Makefile gnucobol/libcob # -# Copyright (C) 2003-2012, 2014, 2017-2020, 2022 Free Software Foundation, Inc. +# Copyright (C) 2003-2012, 2014, 2017-2020, 2022-2023 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch # # This file is part of GnuCOBOL. @@ -38,7 +38,7 @@ AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir)/lib -I$(top_srcdir)/lib \ AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) # note: currently misses libsupport... libcob_la_LIBADD = $(LIBCOB_LIBS) $(CODE_COVERAGE_LIBS) -libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 5:0:1 -no-undefined +libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 6:0:2 -no-undefined AM_LDFLAGS = $(COB_FIX_LIB) pkgincludedir = $(includedir)/libcob diff --git a/libcob/common.h b/libcob/common.h index 8fd422aca..2bb79628e 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -800,21 +800,24 @@ enum cob_exception_id { #define COB_FILE_MODE 0666 -/* Organization, FIXME: change to enum */ - -#define COB_ORG_SEQUENTIAL 0 -#define COB_ORG_LINE_SEQUENTIAL 1 -#define COB_ORG_RELATIVE 2 -#define COB_ORG_INDEXED 3 -#define COB_ORG_SORT 4 -#define COB_ORG_MAX 5 -#define COB_ORG_MESSAGE 6 /* only for syntax checks */ - -/* Access mode, FIXME: change to enum */ +/* file ORGANIZATION IS */ +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, + COB_ORG_MESSAGE = 6 /* only for syntax checks */ +}; -#define COB_ACCESS_SEQUENTIAL 1 -#define COB_ACCESS_DYNAMIC 2 -#define COB_ACCESS_RANDOM 3 +/* file ACCESS MODE IS */ +enum cob_file_access_mode { + COB_ACCESS_UNDEFINED = 0, + COB_ACCESS_SEQUENTIAL = 1, + COB_ACCESS_DYNAMIC = 2, + COB_ACCESS_RANDOM = 3 +}; /* SELECT features */ @@ -1329,6 +1332,9 @@ typedef struct __cob_file_key { unsigned int offset; /* Offset of field */ int count_components; /* 0..1::simple-key 2..n::split-key */ cob_field *component[COB_MAX_KEYCOMP]; /* key-components iff split-key */ +#if 0 /* TODO (for file keys, not for SORT/MERGE) */ + const unsigned char *collating_sequence; /* COLLATING */ +#endif } cob_file_key; @@ -1358,12 +1364,12 @@ typedef struct __cob_file { size_t nkeys; /* Number of keys */ int fd; /* File descriptor */ - unsigned char organization; /* ORGANIZATION */ - unsigned char access_mode; /* ACCESS MODE */ + unsigned char organization; /* ORGANIZATION, read as cob_file_org */ + unsigned char access_mode; /* ACCESS MODE, read as cob_file_access_mode */ unsigned char lock_mode; /* LOCK MODE */ - unsigned char open_mode; /* OPEN MODE: GC4: cob_open_mode */ + unsigned char open_mode; /* OPEN MODE - GC4: cob_open_mode */ unsigned char flag_optional; /* OPTIONAL */ - unsigned char last_open_mode; /* Mode given by OPEN: GC4: cob_open_mode */ + unsigned char last_open_mode; /* Mode given by OPEN - GC4: cob_open_mode */ unsigned char flag_operation; /* File type specific */ unsigned char flag_nonexistent; /* Nonexistent file */ @@ -2451,12 +2457,14 @@ typedef struct __fcd2 { #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 +/* standard OP CODES */ + +#define OP_CLOSE 0xFA80 /* CLOSE */ +#define OP_CLOSE_LOCK 0xFA81 /* CLOSE WITH LOCK */ +#define OP_CLOSE_NO_REWIND 0xFA82 /* CLOSE WITH NO REWIND */ +#define OP_CLOSE_REEL 0xFA84 /* CLOSE REEL/UNIT */ +#define OP_CLOSE_REMOVE 0xFA85 /* CLOSE REEL/UNIT FOR REMOVAL */ +#define OP_CLOSE_NOREWIND 0xFA86 /* CLOSE REEL/UNIT WITH NO REWIND */ #define OP_OPEN_INPUT 0xFA00 #define OP_OPEN_OUTPUT 0xFA01 @@ -2615,11 +2623,15 @@ COB_EXPIMP int cob_sys_file_delete (unsigned char *, unsigned char *); COB_EXPIMP void cob_file_sort_init (cob_file *, const unsigned int, const unsigned char *, void *, cob_field *); +COB_EXPIMP void cob_file_sort_options (cob_file *, const char *, ...); 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_using_extfh (cob_file *, cob_file *, + int (*callfh)(unsigned char *opcode, FCD3 *fcd)); COB_EXPIMP void cob_file_sort_giving (cob_file *, const size_t, ...); +COB_EXPIMP void cob_file_sort_giving_extfh (cob_file *, const size_t, ...); COB_EXPIMP void cob_file_release (cob_file *); COB_EXPIMP void cob_file_return (cob_file *); diff --git a/libcob/fileio.c b/libcob/fileio.c index 5700709a2..18bb06227 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -351,38 +351,41 @@ indexed_keycmp (struct keydesc *k1, struct keydesc *k2) return 0; } -/* Return index number for given key */ +#endif + +/* Return index number for given key and set length attributes */ static int -indexed_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) +cob_findkey_attr (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) { int k,part; *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) { - *fullkeylen = f->keys[k].field->size; + cob_field *key = f->keys[k].field; + if (key + && key->data == kf->data + && f->keys[k].count_components <= 1) { + *fullkeylen = key->size; *partlen = kf->size; - f->mapkey = k; return 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)) { + cob_field *key = f->keys[k].field; + if ((key + && key->data == kf->data + && key->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; + if (key + && key->data == kf->data) { + *partlen = key->size; } else { *partlen = *fullkeylen; } - f->mapkey = k; return k; } } @@ -390,8 +393,6 @@ indexed_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) return -1; } -#endif - /* Define some characters for checking LINE SEQUENTIAL data content */ #define COB_CHAR_CR '\r' #define COB_CHAR_FF '\f' @@ -480,6 +481,7 @@ struct cobsort { int retrieval_queue; struct queue_struct queue[4]; struct file_struct file[4]; + int flag_merge; }; /* End SORT definitions */ @@ -715,43 +717,6 @@ struct indexed_file { DB_LOCK bdb_record_lock; }; -static int -bdb_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) -{ - int k, part; - - *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) { - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return 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)) { - 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 (int)k; - } - } - } - return -1; -} - /* Return total length of the key */ static int bdb_keylen (cob_file *f, int idx) @@ -3864,9 +3829,8 @@ indexed_start_internal (cob_file *f, const int cond, cob_field *key, dupno = 0; ret = 0; /* Look up for the key */ - key_index = bdb_findkey (f, key, &fullkeylen, &partlen); + key_index = f->mapkey = cob_findkey_attr (f, key, &fullkeylen, &partlen); if (key_index < 0) { - f->mapkey = -1; return COB_STATUS_23_KEY_NOT_EXISTS; } p->key_index = key_index; @@ -4871,10 +4835,11 @@ indexed_start (cob_file *f, const int cond, cob_field *key) if (f->flag_nonexistent) { return COB_STATUS_23_KEY_NOT_EXISTS; } - k = indexed_findkey(f, key, &fullkeylen, &partlen); - if(k < 0) { + k = cob_findkey_attr (f, key, &fullkeylen, &partlen); + if (k < 0) { return COB_STATUS_23_KEY_NOT_EXISTS; } + f->mapkey = k; /* Use size of data field; This may indicate a partial key */ klen = partlen; if (klen < 1 || klen > fullkeylen) { @@ -4981,10 +4946,11 @@ indexed_read (cob_file *f, cob_field *key, const int read_opts) if (f->flag_nonexistent) { return COB_STATUS_23_KEY_NOT_EXISTS; } - k = indexed_findkey(f, key, &fullkeylen, &partlen); - if(k < 0) { + k = cob_findkey_attr (f, key, &fullkeylen, &partlen); + if (k < 0) { return COB_STATUS_23_KEY_NOT_EXISTS; } + f->mapkey = k; if (f->curkey != (int)k) { /* Switch to this index */ isstart (fh->isfd, &fh->key[k], 0, @@ -6960,46 +6926,18 @@ cob_delete_file (cob_file *f, cob_field *fnstatus) save_status (f, fnstatus, errno_cob_sts(COB_STATUS_00_SUCCESS)); } -/* Return index number for given key */ +/* Return index number for given key and set length attributes, + storing resulting key field in file's last_key */ int cob_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) { - int k,part; - *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) { + int k = cob_findkey_attr (f, kf, fullkeylen, partlen); #if 0 /* pending merge of r1411 */ - f->last_key = f->keys[k].field; -#endif - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return k; - } + if (k >= 0) { + f->last_key = f->keys[k].field; } - 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)) { -#if 0 /* pending merge of r1411 */ - f->last_key = f->keys[k].field; #endif - 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 k; } /* Copy key data and return length of data copied */ @@ -8044,12 +7982,12 @@ cob_write_block (struct cobsort *hp, const int n) } static void -cob_copy_check (cob_file *to, cob_file *from) +cob_copy_check (cob_field *to_record, cob_field *from_record) { - unsigned char *toptr = to->record->data; - unsigned char *fromptr = from->record->data; - const size_t tosize = to->record->size; - const size_t fromsize = from->record->size; + unsigned char *toptr = to_record->data; + unsigned char *fromptr = from_record->data; + const size_t tosize = to_record->size; + const size_t fromsize = from_record->size; if (unlikely (tosize > fromsize)) { memcpy (toptr, fromptr, fromsize); @@ -8175,17 +8113,19 @@ cob_file_sort_process (struct cobsort *hp) return 0; } +/* SORT/MERGE: insert record 'p' into the sort 'hp' */ static int -cob_file_sort_submit (cob_file *f, const unsigned char *p) +cob_file_sort_submit (struct cobsort *hp, const unsigned char *p) { - struct cobsort *hp = f->file; struct cobitem *q; struct queue_struct *z; int n; +#if 0 /* can't happen */ if (unlikely (!hp)) { return COBSORTNOTOPEN; } +#endif if (unlikely (hp->retrieving)) { return COBSORTABORT; } @@ -8233,15 +8173,17 @@ cob_file_sort_submit (cob_file *f, const unsigned char *p) return 0; } +/* SORT/MERGE: retrieve next record to be output for sort 'hp' into 'p' */ static int -cob_file_sort_retrieve (cob_file *f, unsigned char *p) +cob_file_sort_retrieve (struct cobsort *hp, unsigned char *p) { - struct cobsort *hp = f->file; int res; +#if 0 /* can't happen */ if (unlikely (!hp)) { return COBSORTNOTOPEN; } +#endif if (unlikely (!hp->retrieving)) { res = cob_file_sort_process (hp); if (res) { @@ -8285,7 +8227,7 @@ cob_file_sort_retrieve (cob_file *f, unsigned char *p) return 0; } -/* SORT: initial setup with adding sort definitions to sort file 'f' */ +/* SORT/MERGE: initial setup with adding sort definitions to sort file 'f' */ void cob_file_sort_init (cob_file *f, const unsigned int nkeys, const unsigned char *collating_sequence, @@ -8333,7 +8275,21 @@ cob_file_sort_init (cob_file *f, const unsigned int nkeys, save_status (f, fnstatus, COB_STATUS_00_SUCCESS); } -/* SORT: add key definition to internal sort file 'f' */ +/* SORT/MERGE: additional options for sort file 'f' - so far only note "we're in MERGE" */ +void +cob_file_sort_options (cob_file *f, const char *parms, ...) +{ + struct cobsort *hp = f->file; + + /* note: varargs are currently not used, if more information is added + handle as in cob_accept_field */ + hp->flag_merge = (parms[0] == 'M'); + + /* FIXME: MERGE should expect to have an ordered file (performance) and also test for + that / raise COB_EC_SORT_MERGE_SEQUENCE */ +} + +/* SORT/MERGE: add key definition to internal sort file 'f' */ void cob_file_sort_init_key (cob_file *f, cob_field *field, const int flag, const unsigned int offset) @@ -8344,55 +8300,81 @@ cob_file_sort_init_key (cob_file *f, cob_field *field, const int flag, f->nkeys++; } -/* SORT: add all records from GIVING file 'data_file' to 'sort_file' */ +/* SORT/MERGE: add all records from GIVING file 'data_file' to 'sort_file' */ void cob_file_sort_using (cob_file *sort_file, cob_file *data_file) { - /* FIXME: on each error the approprate USAGE AFTER EXCEPTION/ERROR must be called; - with ISO COBOL2023 this could also mean a local PERFORM WITH EXCEPTION HANDLING; + cob_file_sort_using_extfh (sort_file, data_file, NULL); +} + +/* SORT/MERGE: add all records from GIVING file 'data_file' to 'sort_file', + with optional external file handler 'callfh' */ +void +cob_file_sort_using_extfh (cob_file *sort_file, cob_file *data_file, + int (*callfh)(unsigned char *opcode, FCD3 *fcd)) +{ + /* FIXME: on each error the appropriate USAGE AFTER EXCEPTION/ERROR must be called; and for MF/IBM the check for sort_return == 16 when coming back to stop the SORT! */ + struct cobsort *hp = sort_file->file; int ret; - cob_open (data_file, COB_OPEN_INPUT, 0, NULL); + if (callfh) { + cob_extfh_open (callfh, data_file, COB_OPEN_INPUT, 0, NULL); + } else { + cob_open (data_file, COB_OPEN_INPUT, 0, NULL); + } if (data_file->file_status[0] != '0') { + if (data_file->file_status[0] == '4') { + cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN); + } return; } for (;;) { - cob_read_next (data_file, NULL, COB_READ_NEXT); + if (callfh) { + cob_extfh_read_next (callfh, data_file, NULL, COB_READ_NEXT); + } else { + 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); + cob_copy_check (sort_file->record, data_file->record); + ret = cob_file_sort_submit (hp, sort_file->record->data); if (ret) { break; } } - cob_close (data_file, NULL, COB_CLOSE_NORMAL, 0); + if (callfh) { + cob_extfh_close (callfh, data_file, NULL, COB_CLOSE_NORMAL, 0); + } else { + cob_close (data_file, NULL, COB_CLOSE_NORMAL, 0); + } } -/* SORT: WRITE all records from 'sort_file' to all passed USING files */ -void -cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) + +/* SORT/MERGE: WRITE all records from 'sort_file' to all USING files 'fbase', + with using their optional external file handlers 'callfh' */ +static void +cob_file_sort_giving_internal (cob_file *sort_file, const size_t giving_cnt, + cob_file **fbase, int (**callfh)(unsigned char *opcode, FCD3 *fcd)) { - /* FIXME: on each error the approprate USAGE AFTER EXCEPTION/ERROR must be called; - with ISO COBOL2023 this could also mean a local PERFORM WITH EXCEPTION HANDLING; + /* FIXME: on each error the appropriate USAGE AFTER EXCEPTION/ERROR must be called; and for MF/IBM the check for sort_return == 16 when coming back to stop the SORT! */ struct cobsort *hp = sort_file->file; - cob_file **fbase; + int *opt; size_t i; - va_list args; - int *opt; - int ret; + int ret; - /* setup temporary arrays, OPEN OUTPUT all GIVING files and get write option */ - fbase = cob_malloc (varcnt * sizeof (cob_file *)); - opt = cob_malloc (varcnt * sizeof (int)); - va_start (args, varcnt); - for (i = 0; i < varcnt; ++i) { - cob_file *using_file = fbase[i] = va_arg (args, cob_file *); - cob_open (using_file, COB_OPEN_OUTPUT, 0, NULL); + /* OPEN OUTPUT all GIVING files and get write option */ + opt = cob_malloc (giving_cnt * sizeof (int)); + for (i = 0; i < giving_cnt; ++i) { + cob_file *using_file = fbase[i]; + if (callfh && callfh[i]) { + cob_extfh_open (callfh[i], using_file, COB_OPEN_OUTPUT, 0, NULL); + } else { + cob_open (using_file, COB_OPEN_OUTPUT, 0, NULL); + } if (using_file->file_status[0] == '0') { if (COB_FILE_SPECIAL (using_file) || using_file->organization == COB_ORG_LINE_SEQUENTIAL) { @@ -8401,15 +8383,17 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) opt[i] = 0; } } else { + if (using_file->file_status[0] == '4') { + cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN); + } opt[i] = -1; } } - va_end (args); /* retrieve all records, WRITE each to every GIVING file */ for (;;) { /* retrieve next record to write, stop AT END / error */ - ret = cob_file_sort_retrieve (sort_file, sort_file->record->data); + ret = cob_file_sort_retrieve (hp, sort_file->record->data); if (ret) { if (ret == COBSORTEND) { sort_file->file_status[0] = '1'; @@ -8417,6 +8401,8 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) } else { if (hp->sort_return) { *(int *)(hp->sort_return) = 16; + } else { + /* IBM doc: if not used then a runtime message is displayed */ } sort_file->file_status[0] = '3'; sort_file->file_status[1] = '0'; @@ -8425,15 +8411,19 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) } /* WRITE record to all GIVING files */ - for (i = 0; i < varcnt; ++i) { + for (i = 0; i < giving_cnt; ++i) { cob_file *using_file = fbase[i]; /* skip files which got a permanent error before */ if (opt[i] < 0) { continue; } using_file->record->size = using_file->record_max; - cob_copy_check (using_file, sort_file); - cob_write (using_file, using_file->record, opt[i], NULL, 0); + cob_copy_check (using_file->record, sort_file->record); + if (callfh && callfh[i]) { + cob_extfh_write (callfh[i], using_file, using_file->record, opt[i], NULL, 0); + } else { + cob_write (using_file, using_file->record, opt[i], NULL, 0); + } /* stop writing to this file if we got a permanent write error; note: other files are still written to; therefore SORT-RETURN 16 (early exit) is NOT set here */ @@ -8441,34 +8431,80 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) int j; opt[i] = -2; /* early exit if no GIVING file left */ - for (j = 0; j < varcnt; ++j) { + for (j = 0; j < giving_cnt; ++j) { if (opt[i] >= 0) { break; } } - if (j == varcnt) { + if (j == giving_cnt) { break; } } } - if (i != varcnt) { + if (i != giving_cnt) { break; } } /* all records processed - CLOSE all GIVING files */ - for (i = 0; i < varcnt; ++i) { + for (i = 0; i < giving_cnt; ++i) { cob_file *using_file = fbase[i]; /* skip files not opened */ if (opt[i] == -1) { continue; } - cob_close (using_file, NULL, COB_CLOSE_NORMAL, 0); + if (callfh && callfh[i]) { + cob_extfh_close (callfh[i], using_file, NULL, COB_CLOSE_NORMAL, 0); + } else { + cob_close (using_file, NULL, COB_CLOSE_NORMAL, 0); + } } /* cleanup temporary arrays */ cob_free (opt); cob_free (fbase); + if (callfh) { + cob_free (callfh); + } +} + +/* SORT: WRITE all records from 'sort_file' to all passed USING files */ +void +cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) +{ + cob_file **fbase; + va_list args; + size_t i; + + 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); + cob_file_sort_giving_internal (sort_file, varcnt, fbase, NULL); +} + +/* SORT: WRITE all records from 'sort_file' to all passed USING files, + with using their optional external file handlers */ +void +cob_file_sort_giving_extfh (cob_file *sort_file, const size_t varcnt, ...) +{ + cob_file **fbase; + int (**callfh)(unsigned char *opcode, FCD3 *fcd); + va_list args; + size_t i, i_fh; + + fbase = cob_malloc (varcnt * sizeof (cob_file *)); + callfh = cob_malloc (varcnt * sizeof (void *)); + i_fh = 0; + va_start (args, varcnt); + for (i = 0; i < varcnt; i += 2) { + fbase[i_fh] = va_arg (args, cob_file *); + callfh[i_fh++] = va_arg (args, void *); + } + va_end (args); + cob_file_sort_giving_internal (sort_file, i_fh, fbase, callfh); } /* SORT: close of internal sort file 'f' and deallocation @@ -8503,50 +8539,50 @@ void cob_file_release (cob_file *f) { struct cobsort *hp = f->file; - cob_field *fnstatus; - int ret; if (likely(hp)) { - fnstatus = hp->fnstatus; + cob_field *fnstatus = hp->fnstatus; + const int ret = cob_file_sort_submit (hp, f->record->data); + if (!ret) { + save_status (f, fnstatus, COB_STATUS_00_SUCCESS); + return; + } + if (hp->sort_return) { + *(int *)(hp->sort_return) = 16; + } else { + /* IBM doc: if not used then a runtime message is displayed */ + } + save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } else { - fnstatus = NULL; + save_status (f, NULL, COB_STATUS_30_PERMANENT_ERROR); } - ret = cob_file_sort_submit (f, f->record->data); - if (!ret) { - save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - } - if (likely(hp && hp->sort_return)) { - *(int *)(hp->sort_return) = 16; - } - save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } void cob_file_return (cob_file *f) { struct cobsort *hp = f->file; - cob_field *fnstatus; - int ret; if (likely(hp)) { - fnstatus = hp->fnstatus; + cob_field *fnstatus = hp->fnstatus; + const int ret = cob_file_sort_retrieve (hp, f->record->data); + switch (ret) { + case 0: + save_status (f, fnstatus, COB_STATUS_00_SUCCESS); + return; + case COBSORTEND: + save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); + return; + } + if (hp->sort_return) { + *(int *)(hp->sort_return) = 16; + } else { + /* IBM doc: if not used then a runtime message is displayed */ + } + save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } else { - fnstatus = NULL; - } - ret = cob_file_sort_retrieve (f, f->record->data); - switch (ret) { - case 0: - save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - case COBSORTEND: - save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); - return; - } - if (likely(hp && hp->sort_return)) { - *(int *)(hp->sort_return) = 16; + save_status (f, NULL, COB_STATUS_30_PERMANENT_ERROR); } - save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } char * @@ -8693,7 +8729,6 @@ cob_exit_fileio (void) void cob_init_fileio (cob_global *lptr, cob_settings *sptr) { - cobglobptr = lptr; cobsetptr = sptr; file_cache = NULL; @@ -8766,7 +8801,7 @@ free_extfh_fcd (void) { struct fcd_file *ff,*nff; - for(ff = fcd_file_list; ff; ff = nff) { + for (ff = fcd_file_list; ff; ff = nff) { nff = ff->next; if (ff->free_select) { cob_cache_free ((void*)ff->f->select_name); @@ -9001,11 +9036,26 @@ static void update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) { if (wasOpen >= 0) { - cobglobptr->cob_error_file = f; - if (isdigit(fcd->fileStatus[0]) && fcd->fileStatus[1] != '0') { - cob_set_exception (status_exception[(fcd->fileStatus[0] - '0')]); + const int status_code_1 = isdigit(fcd->fileStatus[0]) + ? COB_D2I (fcd->fileStatus[0]) : 9; + if (status_code_1 == 0) { + /* EOP is non-fatal therefore 00 status but needs exception; + note that this global variable is only set if GnuCOBOL is used + as EXTFH, in every other case we currently can't set EOP; + also note that fcd->lineCount is never read/set */ + if (eop_status == 0) { + cobglobptr->cob_exception_code = 0; } else { - cobglobptr->cob_exception_code = 0; +#if 0 /* correct thing to do, but then also needs to have codegen adjusted + --> module-incompatibility --> 4.x */ + cob_set_exception (eop_status); +#else + cob_set_exception (COB_EC_I_O_EOP); +#endif + eop_status = 0; + } + } else { + cob_set_exception (status_exception[status_code_1]); } if (f->file_status) { memcpy (f->file_status, fcd->fileStatus, 2); @@ -9017,13 +9067,13 @@ update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) if (wasOpen > 0) { if((fcd->openMode & OPEN_NOT_OPEN)) f->open_mode = 0; - else if((fcd->openMode&0x7f) == OPEN_INPUT) + else if((fcd->openMode & 0x7f) == OPEN_INPUT) f->open_mode = COB_OPEN_INPUT; - else if((fcd->openMode&0x7f) == OPEN_OUTPUT) + else if((fcd->openMode & 0x7f) == OPEN_OUTPUT) f->open_mode = COB_OPEN_OUTPUT; - else if((fcd->openMode&0x7f) == OPEN_EXTEND) + else if((fcd->openMode & 0x7f) == OPEN_EXTEND) f->open_mode = COB_OPEN_EXTEND; - else if((fcd->openMode&0x7f) == OPEN_IO) + else if((fcd->openMode & 0x7f) == OPEN_IO) f->open_mode = COB_OPEN_I_O; } f->record_min = LDCOMPX4(fcd->minRecLen); @@ -9034,10 +9084,12 @@ update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) f->record->attr = &alnum_attr; } f->record->size = LDCOMPX4(fcd->curRecLen); +#if 0 /* this disables some expected status 44 */ if (f->record->size < f->record_min) f->record->size = f->record_min; else if (f->record->size > f->record_max) f->record->size = f->record_max; +#endif if (f->record->data != fcd->recPtr && fcd->recPtr != NULL) { @@ -9315,12 +9367,15 @@ copy_fcd_to_file (FCD3* fcd, cob_file *f, struct fcd_file *fcd_list_entry) * Construct FCD based on information from 'cob_file' */ static FCD3 * -find_fcd (cob_file *f) +find_fcd (cob_file *f, int free_fcd) { FCD3 *fcd; struct fcd_file *ff; for (ff = fcd_file_list; ff; ff=ff->next) { if (ff->f == f) { + if (free_fcd == -1) { + ff->free_fcd = -1; + } return ff->fcd; } } @@ -9330,7 +9385,7 @@ find_fcd (cob_file *f) ff->next = fcd_file_list; ff->fcd = fcd; ff->f = f; - ff->free_fcd = 1; + ff->free_fcd = free_fcd; fcd_file_list = ff; return fcd; } @@ -9539,12 +9594,19 @@ update_record_and_keys_if_necessary (cob_file * f, FCD3 *fcd) } f->record->size = LDCOMPX4(fcd->curRecLen); f->record->attr = &alnum_attr; +#if 0 /* this disables some expected status 44 + (the min/max may only be set during OPEN) */ f->record_min = LDCOMPX4(fcd->minRecLen); f->record_max = LDCOMPX4(fcd->maxRecLen); +#endif +#if 1 /* this disables some expected status 44 + and SIGSEGVs if the actual data is only + curRecLen long (+ accessed longer) */ if (f->record->size < f->record_min) f->record->size = f->record_min; if (f->record->size > f->record_max) f->record->size = f->record_max; +#endif if (fcd->fileOrg == ORG_INDEXED) { copy_keys_fcd_to_file (fcd, f, 1); } @@ -9583,7 +9645,7 @@ cob_extfh_open ( COB_UNUSED (sharing); - fcd = find_fcd(f); + fcd = find_fcd (f, 1); f->last_open_mode = (unsigned char)mode; if (mode == COB_OPEN_OUTPUT) STCOMPX2(OP_OPEN_OUTPUT, opcode); @@ -9622,32 +9684,57 @@ cob_extfh_close ( COB_UNUSED (remfil); - fcd = find_fcd (f); + fcd = find_fcd (f, 1); STCOMPX4 (opt, fcd->opt); - STCOMPX2 (OP_CLOSE, opcode); + + switch (opt) { + case COB_CLOSE_LOCK: + STCOMPX2 (OP_CLOSE_LOCK, opcode); + break; + case COB_CLOSE_NO_REWIND: + STCOMPX2 (OP_CLOSE_NO_REWIND, opcode); + break; + case COB_CLOSE_UNIT: + STCOMPX2 (OP_CLOSE_REEL, opcode); + break; + case COB_CLOSE_UNIT_REMOVAL: + STCOMPX2 (OP_CLOSE_REMOVE, opcode); + break; + default: + STCOMPX2 (OP_CLOSE, opcode); + break; + } /* 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); + /* drop internal FCD entry if file was closed */ + if (f->open_mode == COB_OPEN_CLOSED) { + pff = NULL; + for (ff = fcd_file_list; ff; ff=ff->next) { + if (ff->fcd == fcd) { + if (ff->free_fcd == -1) { + break; + } + 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; } - cob_cache_free((void*)ff); - break; + pff = ff; } - pff = ff; } } @@ -9664,7 +9751,7 @@ cob_extfh_start ( int recn; int keyn,keylen,partlen; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); if (f->organization == COB_ORG_INDEXED) { keyn = cob_findkey(f,key,&keylen,&partlen); STCOMPX2(keyn, fcd->refKey); @@ -9672,15 +9759,13 @@ cob_extfh_start ( 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) { + } 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) { + 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; @@ -9709,7 +9794,7 @@ cob_extfh_read ( int recn; int keyn,keylen,partlen; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX4 (read_opts, fcd->opt); if(key == NULL) { if((read_opts & COB_READ_PREVIOUS)) { @@ -9754,7 +9839,7 @@ cob_extfh_read_next ( FCD3 *fcd; int recn; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX4(read_opts, fcd->opt); if((read_opts & COB_READ_PREVIOUS)) { STCOMPX2(OP_READ_PREV, opcode); @@ -9782,7 +9867,7 @@ cob_extfh_write ( FCD3 *fcd; int recn; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX2(OP_WRITE, opcode); STCOMPX2(check_eop, fcd->eop); STCOMPX4(opt, fcd->opt); @@ -9818,9 +9903,8 @@ cob_extfh_rewrite ( FCD3 *fcd; int recn; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX2 (OP_REWRITE, opcode); - STCOMPX4 (rec->size, fcd->curRecLen); STCOMPX4 (opt, fcd->opt); fcd->recPtr = rec->data; if (f->organization == COB_ORG_RELATIVE) { @@ -9852,7 +9936,7 @@ cob_extfh_delete ( FCD3 *fcd; int recn; - fcd = find_fcd (f); + fcd = find_fcd (f, 1); STCOMPX2 (OP_DELETE, opcode); if (f->organization == COB_ORG_RELATIVE) { memset (fcd->relKey, 0, sizeof (fcd->relKey)); @@ -9957,7 +10041,7 @@ cob_file_fcd_adrs (cob_file *f, void *pfcd) } /* LCOV_EXCL_STOP */ if (f->fcd == NULL) { - f->fcd = find_fcd (f); + f->fcd = find_fcd (f, -1); } fcd = f->fcd; if (fcd->openMode == OPEN_NOT_OPEN) { @@ -10032,6 +10116,52 @@ EXTFH (unsigned char *opcode, FCD3 *fcd) return EXTFH3 (opcode, fcd); } +static void +update_key_from_fcd (cob_file *f, FCD3 *fcd, cob_field *kf) +{ + if (fcd->fileOrg == ORG_INDEXED) { + const int k = LDCOMPX2 (fcd->refKey); + const int keylen = LDCOMPX2 (fcd->effKeyLen); + if (k >= 0 + && k <= (int)f->nkeys + && f->keys[k].field) { + cob_field *key = f->keys[k].field; +#if 0 /* the following sets up the _real_ key data, + but the functions called afterwards look out for + the "intermediate" key field; therefore leave as-is */ + kf->size = key->size; + kf->attr = key->attr; + if (f->keys[k].count_components <= 1) { + kf->data = f->record->data + f->keys[k].offset; + } else { + kf->data = key->data; + } +#else + /* copy over key field's attributes and data pointer */ + memcpy (kf, key, sizeof (cob_field)); +#endif + } else { + /* CHECKME: Shouldn't this just result in an error? */ + static unsigned char keywrk[80]; /* key data used for IDX, if not passed */ + memset (keywrk, 0, sizeof (keywrk)); + kf->size = sizeof (keywrk); + kf->attr = &alnum_attr; + kf->data = keywrk; + } + if (keylen != 0 + && keylen < kf->size) { + kf->size = keylen; + } + } else + if (fcd->fileOrg == ORG_RELATIVE) { + cob_field *rel_key = f->keys[0].field; + /* set value in the key field (several functions don't pass this outside of "f") */ + cob_set_int (rel_key, LDCOMPX4 (LSUCHAR (fcd->relKey + 4))); + /* copy over key field's attributes and data pointer */ + memcpy (kf, rel_key, sizeof (cob_field)); + } +} + /* * EXTFH: internal routine */ @@ -10042,11 +10172,9 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) int opcd,sts,opts,eop,k; unsigned char fnstatus[2]; /* storage for local file status field */ - unsigned char keywrk[80]; /* key data used for IDX, if not passed */ /* different cob_fields as some ABI functions operate on those */ cob_field fs[1]; cob_field key[1]; - cob_field rec[1]; cob_file *f; if (fcd->fcdVer != FCD_VER_64Bit) { @@ -10090,28 +10218,9 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) org_handling: switch (fcd->fileOrg) { case ORG_INDEXED: - k = LDCOMPX2(fcd->refKey); - if (k >= 0 - && k <= (int)f->nkeys - && f->keys[k].field) { - key->size = f->keys[k].field->size; - key->attr = f->keys[k].field->attr; - if (f->keys[k].count_components <= 1) { - key->data = f->record->data + f->keys[k].offset; - } else { - key->data = f->keys[k].field->data; - } - } else { - memset (keywrk, 0, sizeof (keywrk)); - key->size = sizeof (keywrk); - key->attr = &alnum_attr; - key->data = keywrk; - } f->organization = COB_ORG_INDEXED; 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)); f->organization = COB_ORG_RELATIVE; break; case ORG_SEQ: @@ -10199,10 +10308,14 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) return -1; } +#if 0 /* this disables some expected status 44 + and SIGSEGV if the actual data is only + record_min long (+ accessed longer) */ if (f->record && f->record->size < f->record_min) { f->record->size = f->record_min; } +#endif /* handle OPEN/CLOSE operations */ @@ -10284,11 +10397,15 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) return sts; case OP_CLOSE: - case OP_CLOSE_REEL: cob_close (f, fs, COB_CLOSE_NORMAL, 0); update_file_to_fcd (f, fcd, fnstatus); return sts; + case OP_CLOSE_REEL: + cob_close (f, fs, COB_CLOSE_UNIT, 0); + update_file_to_fcd (f, fcd, fnstatus); + return sts; + case OP_CLOSE_LOCK: cob_close (f, fs, COB_CLOSE_LOCK, 0); update_file_to_fcd (f, fcd, fnstatus); @@ -10336,11 +10453,6 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) return -1; } - /* create a local record field as following ABI functions expect it */ - rec->data = fcd->recPtr; - rec->size = LDCOMPX4(fcd->curRecLen); - rec->attr = &alnum_attr; - #if 0 /* CHECKME: why should we adjust the access mode? If wrong file, status should be raised in the following functions */ if (f->organization == COB_ORG_INDEXED @@ -10386,7 +10498,11 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) case OP_STEP_NEXT_LOCK: case OP_STEP_NEXT_NO_LOCK: case OP_STEP_NEXT_KEPT_LOCK: + /* use READ as an alias for STEP */ opts = COB_READ_NEXT; + /* FIXME "the current record pointer is not changed with STEP", + so either store on first STEP / restore on first non-STEP; + or implement step routines */ if (opcd == OP_STEP_NEXT_LOCK) opts |= COB_READ_LOCK; else if (opcd == OP_STEP_NEXT_NO_LOCK) @@ -10401,7 +10517,11 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) case OP_STEP_FIRST_LOCK: case OP_STEP_FIRST_NO_LOCK: case OP_STEP_FIRST_KEPT_LOCK: + /* use READ as an alias for STEP */ opts = COB_READ_FIRST; + /* FIXME "the current record pointer is not changed with STEP", + so either store on first STEP / restore on first non-STEP; + or implement step routines */ if (opcd == OP_STEP_FIRST_LOCK) opts |= COB_READ_LOCK; else if (opcd == OP_STEP_FIRST_NO_LOCK) @@ -10412,6 +10532,13 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) update_file_to_fcd (f, fcd, NULL); break; + case OP_READ_DIR: + case OP_READ_DIR_LOCK: + case OP_READ_DIR_NO_LOCK: + case OP_READ_DIR_KEPT_LOCK: + /* CHECKME: is this handling correct? */ + /* Fall through */ + case OP_READ_RAN: case OP_READ_RAN_LOCK: case OP_READ_RAN_NO_LOCK: @@ -10423,75 +10550,108 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) opts |= COB_READ_NO_LOCK; else if (opcd == OP_READ_RAN_KEPT_LOCK) opts |= COB_READ_KEPT_LOCK; + update_key_from_fcd (f, fcd, key); cob_read (f, key, fs, opts); update_file_to_fcd (f, fcd, fnstatus); break; - case OP_WRITE: + case OP_WRITE: { + cob_field rec[1]; + rec->data = fcd->recPtr; + rec->size = LDCOMPX4 (fcd->curRecLen); + rec->attr = &alnum_attr; +#if 0 /* Simon: min/max from FCD may only be accessed on OPEN */ if (f->record && rec->size >= LDCOMPX4(fcd->minRecLen) && rec->size <= LDCOMPX4(fcd->maxRecLen)) { f->record->size = rec->size; } +#endif +#if 1 /* Simon: breaks status 44 and + can lead to SIGSEGV if there's only curRecLen + data available */ if (rec->size < f->record_min) { rec->size = f->record_min; } +#endif eop = LDCOMPX2(fcd->eop); opts = LDCOMPX4(fcd->opt); + update_key_from_fcd (f, fcd, key); cob_write (f, rec, opts, fs, eop); update_file_to_fcd (f, fcd, fnstatus); break; + } - case OP_REWRITE: + case OP_REWRITE: { + cob_field rec[1]; + rec->data = fcd->recPtr; + rec->size = LDCOMPX4 (fcd->curRecLen); + rec->attr = &alnum_attr; +#if 0 /* Simon: min/max from FCD may only be accessed on OPEN */ if (f->record - && rec->size >= LDCOMPX4(fcd->minRecLen) - && rec->size <= LDCOMPX4(fcd->maxRecLen)) { + && rec->size >= LDCOMPX4 (fcd->minRecLen) + && rec->size <= LDCOMPX4 (fcd->maxRecLen)) { f->record->size = rec->size; } +#endif +#if 1 /* Simon: breaks status 44 and + can lead to SIGSEGV if there's only curRecLen + data available */ if (rec->size < f->record_min) { rec->size = f->record_min; } +#endif opts = LDCOMPX4(fcd->opt); + update_key_from_fcd (f, fcd, key); cob_rewrite (f, rec, opts, fs); update_file_to_fcd (f, fcd, fnstatus); break; + } case OP_DELETE: + update_key_from_fcd (f, fcd, key); cob_delete (f, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_EQ: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_EQ, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_GE: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_GE, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_LE: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_LE, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_LT: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_LT, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_GT: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_GT, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_FI: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_FI, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_LA: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_LA, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; diff --git a/tests/atlocal.in b/tests/atlocal.in index 7213bf931..405c24a12 100644 --- a/tests/atlocal.in +++ b/tests/atlocal.in @@ -72,6 +72,7 @@ fi # FLAGS="-debug -Wall ${COBOL_FLAGS}" FLAGS="-debug -Wall ${COBOL_FLAGS} -fno-diagnostics-show-option" +COBC="${COBC} -fdiagnostics-plain-output" COMPILE="${COBC} -x ${FLAGS}" COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS} -Wno-unsupported" COMPILE_MODULE="${COBC} -m ${FLAGS}" diff --git a/tests/cobol85/ChangeLog b/tests/cobol85/ChangeLog index 88dd68b65..bb6d3f366 100644 --- a/tests/cobol85/ChangeLog +++ b/tests/cobol85/ChangeLog @@ -1,4 +1,8 @@ +2023-06-02 Simon Sobisch + + * report.pl: place stderr from test runs into .out file + 2023-04-07 Simon Sobisch * report.pl: check "cobc_flags" also for building lib; diff --git a/tests/cobol85/report.pl b/tests/cobol85/report.pl index a6f1ba43f..9989fe8e3 100755 --- a/tests/cobol85/report.pl +++ b/tests/cobol85/report.pl @@ -225,8 +225,8 @@ # the following failed in previous versions with --debug, # but don't do any more -# MOVE from PIC S9999 SEPARATE with "expected" value of SPACES to a target -# of X(5) - RECHECK: is a conversion and therefore check needed? +# this was a bad generation from PIC S9999 SEPARATE to +# a target of X(5) where no conversion is needed $cobc_flags{DB201A} = "-fno-ec=data-incompatible"; # 2.2 generated DEBUG-LINE as numeric - but it always was X(6) @@ -434,12 +434,12 @@ sub run_test { testrepeat: if (!$to_kill{$exe}) { - $ret = system ("$TRAP $cmd > $exe.out"); + $ret = system ("$TRAP $cmd > $exe.out 2>&1"); } else { $ret = system ("$TRAP $cmd > $exe.out 2>/dev/null"); } - # extra check for both SIGINT as masked signal and as plain return, because + # extra check for SIGINT both as masked signal and as plain return, because # AIX (at least 7.1 with GCC 4.2 and system libc) directly returns 2 if ($ret != 0 && !($to_kill{$exe} && ($ret >> 2 || $ret == 2))) { if (($ret >> 8) == 77) { diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index a6d43eaba..df3c6c106 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -2143,8 +2143,8 @@ LINE PG/LN A...B............................................................ GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 command line: - cobc -q -std=default -Wall -fno-tmessages -fsyntax-only -t prog.lst -+ -fno-tsymbols -ftcmd prog.cob + cobc -fdiagnostics-plain-output -q -std=default -Wall -fno-tmessages ++ -fsyntax-only -t prog.lst -fno-tsymbols -ftcmd prog.cob ]) AT_CHECK([$UNIFY_LISTING prog.lst prog.lis], [0], [], []) diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index 3eea5ef70..db13d7769 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -2003,9 +2003,10 @@ AT_CLEANUP AT_SETUP([INDEXED file split keys WITH DUPLICATES]) -AT_KEYWORDS([runfile key]) +AT_KEYWORDS([runfile key EXTFH]) AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) + ## Note: The order in which secondary records with duplicate keys ## are returnded is not guaranteed. @@ -2157,6 +2158,13 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +# verify that all of this works with wrapping to EXTFH calls and +# back to our own EXTFH entry point + +AT_CHECK([$COMPILE -fcallfh=EXTFH -o extfh prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./extfh], [0], [], []) + AT_CLEANUP @@ -4777,55 +4785,55 @@ AT_DATA([prog.cob], [ 01 page-count pic 9999. PROCEDURE DIVISION. + main. + open input data-file. + read data-file + at end + display "File open error: " data-file-status + stop run + end-read. - open input data-file. - read data-file - at end - display "File open error: " data-file-status - stop run - end-read. - - open output mini-report. + open output mini-report. - write report-line - from report-line-blank - end-write. + 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. + 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. + perform readwrite-loop until endofdata. - display - "Normal termination, ending status: " - data-file-status - close mini-report. + display + "Normal termination, ending status: " + data-file-status + close mini-report. - close data-file. - stop run. + 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 - . + 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]) @@ -4921,49 +4929,49 @@ PAGE: 0004 LC: 000015 DATE: 150206 000008 01 page-count pic 9999. 000009 000010 PROCEDURE DIVISION. -000011 -000012 open input data-file. -000013 read data-file -000014 at end +000011 main. +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. +000001 display "File open error: " data-file-status +000002 stop run +000003 end-read. 000004 -000005 open output mini-report. +000005 open output mini-report. 000006 -000007 write report-line -000008 from report-line-blank -000009 end-write. +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 +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. +000001 from report-line-header +000002 after advancing page +000003 end-write. 000004 -000005 perform readwrite-loop until endofdata. +000005 perform readwrite-loop until endofdata. 000006 -000007 display -000008 "Normal termination, ending status: " -000009 data-file-status -000010 close mini-report. +000007 display +000008 "Normal termination, ending status: " +000009 data-file-status +000010 close mini-report. 000011 -000012 close data-file. -000013 stop run. +000012 close data-file. +000013 stop run. 000014 @@ -4973,27 +4981,27 @@ PAGE: 0006 LC: 000015 DATE: 150206 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 +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 . +000001 at end set endofdata to true +000002 end-read +000003 . ]) AT_CHECK([$COMPILE prog.cob], [0], [], []) @@ -5005,6 +5013,296 @@ AT_CHECK([diff mini-report reference-report], [0], [], []) AT_CLEANUP +AT_SETUP([EXTFH: LINAGE and LINAGE-COUNTER sample]) +AT_KEYWORDS([runfile EXTFH OPTIONAL FILE STATUS READ WRITE END-OF-PAGE LINE SEQUENTIAL]) + +# modified version of the test above + +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). + + + + + 01 page-count pic 9999. + + PROCEDURE DIVISION. + main. + 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. + 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 +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 +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 +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 +000001 02 filler pic x(24). +000002 02 filler pic x(5) VALUE " LC: ". +000003 02 header-tag pic 9(6). +000004 +000005 +000006 +000007 +000008 01 page-count pic 9999. +000009 +000010 PROCEDURE DIVISION. +000011 main. +000012 open input data-file. +000013 read data-file +000014 at end + + + + + +PAGE: 0005 LC: 000015 +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 +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 +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 +000001 at end set endofdata to true +000002 end-read +000003 . +]) + +AT_CHECK([$COMPILE -fcallfh=EXTFH prog.cob], [0], [], []) + +# currently does not generate the expected report, as LINAGE options +# are not passed via FCD and the internal part works only "partial" + +AT_XFAIL_IF([true]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[Normal termination, ending status: 10 +], []) +AT_CHECK([diff mini-report reference-report], [0], [], []) + +AT_CLEANUP + + AT_SETUP([SEQUENTIAL file I/O with variable records]) AT_KEYWORDS([runfile]) @@ -8292,8 +8590,11 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Other Flags 32. +AT_CAPTURE_FILE([prog.out]) + +AT_CHECK([$COBCRUN_DIRECT ./prog 1>prog.out], [0], [], []) + +AT_DATA([reference], [Other Flags 32. File has 0003 keys. Key def 0112 bytes. File assigned is 'mytstisam' @@ -8366,7 +8667,18 @@ 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_CHECK([diff reference prog.out], [0], [], []) + +# verify that all of this works with wrapping to EXTFH calls +# and that those don't trash the FH--FCD allocated memory + +AT_CHECK([$COMPILE -fcallfh=EXTFH -o extfh prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./extfh 1>prog.out], [0], [], []) + +AT_CHECK([diff reference prog.out], [0], [], []) + AT_CLEANUP @@ -9035,19 +9347,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL WRITES COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO CREATE LINE SEQUENTIAL FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN LINE SEQUENTIAL FILE AS OUTPUT.' @@ -9080,19 +9392,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' OR '10' DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL READS COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO READ LINE SEQUENTIAL FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN LINE SEQUENTIAL FILE AS INPUT.' @@ -9156,6 +9468,12 @@ AT_CLEANUP AT_SETUP([EXTFH: FIXED SEQUENTIAL]) AT_KEYWORDS([runfile EXTFH]) +# CHECKME: Should it really be possible to change the length +# with a line-sequentia file this way? +# If yes: should there be an implied "WRITE FROM" - so +# that an intermediate record field, space padded, is +# internally used? + AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. @@ -9233,19 +9551,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' DISPLAY PROGRAM-NAME ': FIXED SEQ WRITES COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': FIXED SEQ FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE FIXED SEQ FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO CREATE FIXED SEQ FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': FIXED SEQ FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE FIXED SEQ FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN FIXED SEQ FILE AS OUTPUT.' @@ -9283,19 +9601,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' OR '10' DISPLAY PROGRAM-NAME ': FIXED SEQ READS COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE FIXED SEQ FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO READ FIXED SEQ FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE FIXED SEQ FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN FIXED SEQ FILE AS INPUT.' @@ -9522,6 +9840,10 @@ kdblen: 0398 AT_CLEANUP +# TODO: add missing test for CLOSE options (most important: REEL) +# which are missing both for "normal" io and for EXTFH tests + + AT_SETUP([EXTFH: changing record address]) AT_KEYWORDS([runfile EXTFH]) @@ -11161,7 +11483,7 @@ AT_CLEANUP AT_SETUP([INDEXED File READ/DELETE/READ]) -AT_KEYWORDS([runfile READ DELETE]) +AT_KEYWORDS([runfile READ DELETE EXTFH]) AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) @@ -11838,8 +12160,11 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample data file. +AT_CAPTURE_FILE([prog.out]) + +AT_CHECK([$COBCRUN_DIRECT ./prog 1>prog.out], [0], [], []) + +AT_DATA([reference], [Loading sample data file. Sample data file load complete. List sample data file Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 . @@ -11951,7 +12276,14 @@ 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_CHECK([diff reference prog.out], [0], [], []) + +AT_CHECK([$COMPILE -fcallfh=EXTFH -o extfh prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./extfh 1>prog.out], [0], [], []) + +AT_CHECK([diff reference prog.out], [0], [], []) AT_CLEANUP @@ -12627,7 +12959,7 @@ AT_CLEANUP AT_SETUP([File SORT, SEQUENTIAL]) -AT_KEYWORDS([runfile using giving]) +AT_KEYWORDS([runfile SORT USING GIVING]) # Note: We shouldn't use AT_DATA to create sequential record # data, because AT_DATA needs a \n at the end @@ -12677,7 +13009,7 @@ AT_CLEANUP AT_SETUP([File SORT, SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) +AT_KEYWORDS([runfile SORT USING GIVING]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -12763,7 +13095,7 @@ AT_CLEANUP AT_SETUP([File SORT, LINE SEQUENTIAL]) -AT_KEYWORDS([runfile using giving]) +AT_KEYWORDS([runfile SORT USING GIVING]) # Note: We shouldn't use AT_DATA to create sequential record # data, because AT_DATA needs a \n at the end @@ -12822,7 +13154,7 @@ AT_CLEANUP AT_SETUP([File SORT, LINE SEQUENTIAL same file]) -AT_KEYWORDS([runfile using giving]) +AT_KEYWORDS([runfile SORT USING GIVING]) AT_DATA([test.txt], [ bla @@ -12869,7 +13201,7 @@ AT_CLEANUP AT_SETUP([File SORT, LINE SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) +AT_KEYWORDS([runfile SORT USING GIVING]) AT_DATA([file1], [A1XXXX @@ -12932,6 +13264,73 @@ Z9XXXXXXXXXX AT_CLEANUP +AT_SETUP([EXTFH: File SORT, LINE SEQUENTIAL variable records]) +AT_KEYWORDS([runfile SORT USING GIVING EXTFH]) + +# same test as above, but this time using an external file handler +# which in this case is the internal EXTFH handler + +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 -fcallfh=EXTFH 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]) diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 79c481728..ca0e6ac41 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -6530,10 +6530,10 @@ AT_DATA([prog.cob], [ 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 +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 diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 3d42db4b7..abdce6f60 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -918,3 +918,95 @@ AT_CHECK([cat prog.cob | $COMPILE_MODULE -j -], [0], [job], [], ) AT_CLEANUP + + +AT_SETUP([cobc diagnostics show caret]) +#AT_KEYWORDS([cobc diagnostics]) +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... +]) + +# note: $COBC has -fdiagnostics-plain-output +AT_CHECK([$COBC -Wall -fsyntax-only prog.cob], [1], [], +[[prog.cob:7: error: CRUD.CPY: No such file or directory +prog.cob:6: warning: numeric value is expected [-Wothers] +prog.cob:14: warning: ignoring redundant . [-Wothers] +]]) +AT_CHECK([$COBC -fdiagnostics-show-caret -fdiagnostics-show-line-numbers prog.cob], [1], [], +[[prog.cob:7: error: CRUD.CPY: No such file or directory + 5 | WORKING-STORAGE SECTION. + 6 | 01 TEST-VAR PIC 9(2) VALUE 'A'. + 7 > COPY 'CRUD.CPY'. + 8 | PROCEDURE DIVISION. + 9 | DISPLAY TEST-VAR NO ADVANCING +prog.cob:6: warning: numeric value is expected [-Wothers] + 4 | DATA DIVISION. + 5 | WORKING-STORAGE SECTION. + 6 > 01 TEST-VAR PIC 9(2) VALUE 'A'. + 7 | COPY 'CRUD.CPY'. + 8 | PROCEDURE DIVISION. +prog.cob:14: warning: ignoring redundant . [-Wothers] + 12 | DISPLAY TEST-VAR NO ADVANCING + 13 | END-DISPLAY + 14 > STOP RUN... + 15 | +]]) + +AT_CHECK([$COBC -fdiagnostics-show-caret prog.cob], [1], [], +[[prog.cob:7: error: CRUD.CPY: No such file or directory + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC 9(2) VALUE 'A'. + > COPY 'CRUD.CPY'. + PROCEDURE DIVISION. + DISPLAY TEST-VAR NO ADVANCING +prog.cob:6: warning: numeric value is expected [-Wothers] + DATA DIVISION. + WORKING-STORAGE SECTION. + > 01 TEST-VAR PIC 9(2) VALUE 'A'. + COPY 'CRUD.CPY'. + PROCEDURE DIVISION. +prog.cob:14: warning: ignoring redundant . [-Wothers] + DISPLAY TEST-VAR NO ADVANCING + END-DISPLAY + > STOP RUN... + +]]) + +# Testcase for trailing whitespace +AT_CHECK([sed -e 's/DIVISION\./DIVISION \.\t \t /' prog.cob > progsp.cob]) + +AT_CHECK([$COBC -Wno-others -fdiagnostics-show-caret progsp.cob], [1], [], +[[progsp.cob:7: error: CRUD.CPY: No such file or directory + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC 9(2) VALUE 'A'. + > COPY 'CRUD.CPY'. + PROCEDURE DIVISION . + DISPLAY TEST-VAR NO ADVANCING +]]) + +# Testcase for line too long and printing only one line +AT_DATA([longgy.cob],[ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd +]) + +# note: this is actually an error in the parser line number, +# but until that is solved, it is a nice edge case of "line not available" +AT_CHECK([$COBC -Wno-others -fdiagnostics-show-caret longgy.cob], [1], [], +[[longgy.cob:2: error: PROGRAM-ID header missing + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd.. + > +]]) + +AT_CLEANUP +