diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index 2b2d9ba0f1868bc3877cd6e733501c89a91e9b14..b77871d9e135d622ea229c5d39b2574df5519a45 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -395,26 +395,6 @@ cobol_langhook_getdecls (void)
return NULL;
}
-/*
- * The plastic around case transformation isn't needed now, and might
- * never be. The macro TOLOWERCASE is left over from before we were
- * able to use tolower(3), and is easy to remember. If desired, the
- * user can redefine it.
- */
-//#ifndef TOLOWERCASE
-//# define TOLOWERCASE(ch) tolower((ch))
-//#endif
-
-int TOLOWERCASE(int ch)
- {
- if( ch >= 'A' && ch <= 'Z' )
- {
- ch = ch | 0x20;
- }
- return ch;
- }
-
-
char *
cobol_name_mangler(const char *cobol_name_)
{
@@ -466,7 +446,7 @@ cobol_name_mangler(const char *cobol_name_)
// with an underscore
has_dash = true;
}
- *d++ = TOLOWERCASE(ch);
+ *d++ = TOLOWER(ch);
}
*d++ = '\0';
@@ -570,7 +550,7 @@ cobol_name_mangler_callback(const char *cobol_name_)
// with an underscore
has_dash = true;
}
- *d++ = TOLOWERCASE(ch);
+ *d++ = TOLOWER(ch);
}
*d++ = '\0';
diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc
index cc504683ff54f2061d6b62e4c4c5cde78a6bc224..63d68c39059be46811fa6b2bd1cfe32bc58d1abc 100644
--- a/gcc/cobol/lexio.cc
+++ b/gcc/cobol/lexio.cc
@@ -781,7 +781,7 @@ parse_replace_pairs( const char *stmt, const char *estmt, bool is_copy_stmt ) {
char *s;
if( -1 == asprintf(&s, "%s(%s)%s", befter[0], src, befter[1]) ) {
- err(EXIT_FAILURE, __func__);
+ err(EXIT_FAILURE, "error: %s: %m", __func__);
}
src = s;
diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h
index 5dfe89f72d885a4b0a33baa201fd873493b4109c..680e2b9b273e780031ebb50e7931477ff588ac8f 100644
--- a/gcc/cobol/lexio.h
+++ b/gcc/cobol/lexio.h
@@ -34,6 +34,7 @@
#include <cctype>
#include <cstdlib>
#include <cstring>
+
#include <err.h>
#include <sys/mman.h>
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 831df3c6ef6ed7224091398ef0829a2e615f163a..a3f1dfe1f62f3c8e963c27bf384e2d7ac38e447c 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -41,7 +41,7 @@
};
enum accept_func_t {
- accept_none_e,
+ accept_done_e,
accept_command_line_e,
accept_envar_e,
};
@@ -4452,10 +4452,24 @@ statement: error {
| write { $$ = WRITE; }
;
+ /*
+ * ISO defines ON EXCEPTION only for Format 3 (screen). We
+ * implement extensions defined by MF and Fujitsu (and us) to
+ * use ACCEPT to interact with the command line and the
+ * environment.
+ *
+ * ISO ACCEPT and some others are implemented in accept_body,
+ * before the parser sees any ON EXCEPTION. In those cases
+ * accept_body returns accept_done_e to denote that the
+ * statement has been handled. If ON EXCEPTION is then parsed,
+ * it's an error. Otherwise, accept_body returns something
+ * else, and the relevant parser_accept_foo function is called
+ * in the "accept" action.
+ */
accept: accept_body end_accept {
cbl_field_t *argi = register_find("_ARGI");
switch( $accept_body.func ) {
- case accept_none_e:
+ case accept_done_e:
break;
case accept_command_line_e:
if( $1.from->field == NULL ) { // take next command-line arg
@@ -4476,7 +4490,7 @@ accept: accept_body end_accept {
| accept_body accept_excepts[ec] end_accept {
cbl_field_t *argi = register_find("_ARGI");
switch( $accept_body.func ) {
- case accept_none_e:
+ case accept_done_e:
yyerror("error: ON EXCEPTION valid only "
"with ENVIRONMENT or COMAMND-LINE(n)");
break;
@@ -4510,12 +4524,12 @@ end_accept: %empty %prec ACCEPT
accept_body: accept_refer
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
parser_accept(*$1, CONSOLE_e);
}
| accept_refer FROM DATE
{
- $$.func = accept_none_e;
+ $$.func = accept_done_e;
if( $1->is_reference() ) {
yyerror("subscripts are unsupported here");
YYERROR;
@@ -4524,7 +4538,7 @@ accept_body: accept_refer
}
| accept_refer FROM DATE YYYYMMDD
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
if( $1->is_reference() ) {
yyerror("subscripts are unsupported here");
YYERROR;
@@ -4533,7 +4547,7 @@ accept_body: accept_refer
}
| accept_refer FROM DAY
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
if( $1->is_reference() ) {
yyerror("subscripts are unsupported here");
YYERROR;
@@ -4542,7 +4556,7 @@ accept_body: accept_refer
}
| accept_refer FROM DAY YYYYDDD
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
if( $1->is_reference() ) {
yyerror("subscripts are unsupported here");
YYERROR;
@@ -4551,7 +4565,7 @@ accept_body: accept_refer
}
| accept_refer FROM DAY_OF_WEEK
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
if( $1->is_reference() ) {
yyerror("subscripts are unsupported here");
YYERROR;
@@ -4561,7 +4575,7 @@ accept_body: accept_refer
| accept_refer FROM TIME
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
if( $1->is_reference() ) {
yyerror("subscripts are unsupported here");
YYERROR;
@@ -4583,7 +4597,7 @@ accept_body: accept_refer
$$.from = cbl_refer_t::empty();
break;
default:
- $$.func = accept_none_e;
+ $$.func = accept_done_e;
parser_accept( *$1, $acceptable->id );
}
}
@@ -4596,7 +4610,7 @@ accept_body: accept_refer
}
| accept_refer FROM COMMAND_LINE
{
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
parser_accept_command_line(*$1, NULL, NULL, NULL );
}
| accept_refer FROM COMMAND_LINE '(' expr ')'
@@ -4607,7 +4621,7 @@ accept_body: accept_refer
//// parser_accept_command_line(*$1, $expr->field );
}
| accept_refer FROM COMMAND_LINE_COUNT {
- $$.func = accept_none_e;;
+ $$.func = accept_done_e;
parser_accept_command_line_count(*$1);
}
;
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index ee41f5093fdbb44baf67e873b074cd910d1c25a9..662a17ca8c42b47296d651021a03eff8a70f4c6c 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -28,6 +28,19 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+/*
+ * This file supports parsing without requiring access to the symbol
+ * table definition. Unlike the Bison input, this file brings in gcc
+ * header files.
+ *
+ * The system.h file includes safe-ctype.h from libiberty, which
+ * disables bog-standard functions like isdigit(3) on the grounds that
+ * they may be affected by the locale. We include lexio.h first, so
+ * that it can use the standard functions. The rest of util.cc uses
+ * the libiberty uppercase replacements.
+ */
+#include "lexio.h"
+
#include <assert.h>
#include <err.h>
#include <regex.h>
@@ -56,7 +69,6 @@
#include "symbols.h"
#include "genapi.h"
-#include "lexio.h"
#pragma GCC diagnostic ignored "-Wunused-result"
@@ -225,7 +237,7 @@ is_alpha_edited( const char picture[] ) {
for( const char *p = picture; *p != '\0'; p++ ) {
if( strchr(valid, *p) ) continue;
- if( isdigit(*p) ) continue;
+ if( ISDIGIT(*p) ) continue;
if( symbol_decimal_point() == *p ) continue;
if( symbol_currency(*p) ) continue;
@@ -271,7 +283,7 @@ is_numeric_edited( const char picture[] ) {
for( p=picture; (p = strchr(p, ')')) != NULL; p++ ) {
auto prior = p;
while( picture < prior-- ) {
- if( isdigit(*prior) ) continue;
+ if( ISDIGIT(*prior) ) continue;
if( *prior == '(' ) break;
numed_message = "error: unbalanced parentheses in PICTURE";
return false;
@@ -285,17 +297,17 @@ is_numeric_edited( const char picture[] ) {
for( p = picture; *p != '\0'; p++ ) {
if( strchr(valid, *p) ) continue;
- if( isdigit(*p) ) continue;
+ if( ISDIGIT(*p) ) continue;
if( symbol_decimal_point() == *p ) continue;
if( symbol_currency(*p) ) continue;
switch(*p) { // test for CR or DB
case 'C': case 'c':
- if( toupper(*++p) == 'R' ) continue;
+ if( TOUPPER(*++p) == 'R' ) continue;
numed_message = "error: expected CR in PICTURE";
break;
case 'D': case 'd':
- if( toupper(*++p) == 'B' ) continue;
+ if( TOUPPER(*++p) == 'B' ) continue;
numed_message = "error: expected DB in PICTURE";
break;
default:
@@ -871,7 +883,7 @@ cbl_field_t::report_invalid_initial_value() const {
} else {
auto has_exponent = std::any_of( p, pend,
[]( char ch ) {
- return toupper(ch) == 'E';
+ return TOUPPER(ch) == 'E';
} );
if( !has_exponent && data.precision() < pend - p ) {
yyerrorv("error: %s cannot represent VALUE '%.*s' exactly (max .%zu)",
@@ -913,9 +925,9 @@ cbl_field_t::report_invalid_initial_value() const {
data.initial +
strlen(data.initial),
[]( char ch ) {
- return isspace(ch) ||
- ispunct(ch) ||
- isalpha(ch); } );
+ return ISSPACE(ch) ||
+ ISPUNCT(ch) ||
+ ISALPHA(ch); } );
}
if( ! alpha_value ) {
yyerrorv("error: alpha-only %s VALUE '%s' contains non-alphabetic data",
@@ -1080,7 +1092,7 @@ valid_move( const struct cbl_field_t *tgt, const struct cbl_field_t *src )
};
/* Needs C++11 */
static_assert(sizeof(matrix[0]) == COUNT_OF(matrix[0]),
- "matrix should be square");
+ "matrix should be square");
for( const cbl_field_t *args[] = {tgt, src}, **p=args;
p < args + COUNT_OF(args); p++ ) {
@@ -1124,16 +1136,16 @@ valid_move( const struct cbl_field_t *tgt, const struct cbl_field_t *src )
{
case 0:
if( src->type == FldLiteralA && is_numericish(tgt) && !is_literal(tgt) ) {
- // Allow if input string is an integer.
- const char *p = src->data.initial, *pend = p + src->data.capacity;
- if( p[0] == '+' || p[0] == '-' ) p++;
- retval = std::all_of( p, pend, isdigit );
- if( yydebug && ! retval ) {
- auto bad = std::find_if( p, pend,
- []( char ch ) { return ! isdigit(ch); } );
- warnx("%s:%d: offending character '%c' at position %zu",
- __func__, __LINE__, *bad, bad - p);
- }
+ // Allow if input string is an integer.
+ const char *p = src->data.initial, *pend = p + src->data.capacity;
+ if( p[0] == '+' || p[0] == '-' ) p++;
+ retval = std::all_of( p, pend, isdigit );
+ if( yydebug && ! retval ) {
+ auto bad = std::find_if( p, pend,
+ []( char ch ) { return ! ISDIGIT(ch); } );
+ warnx("%s:%d: offending character '%c' at position %zu",
+ __func__, __LINE__, *bad, bad - p);
+ }
}
break;
case 1:
@@ -1772,7 +1784,7 @@ static size_t record_count( cbl_file_t *file ) {
if( 0 != sb.st_size % size ) {
warnx("file %s is %zu bytes, not a multiple of record size %zu",
- file->name, sb.st_size, size);
+ file->name, sb.st_size, size);
}
return sb.st_size / size;
}
@@ -2013,7 +2025,7 @@ bool cobol_filename( const char *name, ino_t inode ) {
input_filenames.top().lineno = yylineno = 1;
if( getenv(__func__) ) {
warnx(" saving %s with lineno as %d",
- input_filenames.top().name, input_filenames.top().lineno);
+ input_filenames.top().name, input_filenames.top().lineno);
}
symbol_cobol_filename_begin(name);
return pushed;
@@ -2048,7 +2060,7 @@ cobol_filename_restore() {
yylineno = input.lineno;
if( getenv("cobol_filename") ) {
warnx("restoring %s with lineno to %d",
- input_filenames.top().name, input.lineno);
+ input_filenames.top().name, input.lineno);
}
symbol_cobol_filename_begin(input.name);
return input.name;