diff --git a/gcc/cobol/UAT/testsuite.src/fixed_format.at b/gcc/cobol/UAT/testsuite.src/fixed_format.at
index 44138c533c6d19f400f710d4bd21df3f2ba24721..dfe1a4afa7c4a4c4c8a3b43377a4c8984876dd3c 100644
--- a/gcc/cobol/UAT/testsuite.src/fixed_format.at
+++ b/gcc/cobol/UAT/testsuite.src/fixed_format.at
@@ -80,7 +80,8 @@ AT_DATA([prog.cob], [
EXIT PROGRAM.
])
-AT_CHECK([$COMPILE_FIXED prog.cob], [1], [], [prog.cob:4: syntax error at 'Bad'
+AT_CHECK([$COMPILE_FIXED prog.cob], [1], [],
+[prog.cob:4: error: stray indicator '.' (0x2e): " .Bad Indicator character in correct column"
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
@@ -95,7 +96,8 @@ AT_DATA([prog.cob], [
DISPLAY 'Should display'.
EXIT PROGRAM.
])
-AT_CHECK([$COMPILE_FIXED prog.cob], [1], [], [prog.cob:4: syntax error at 'Bad'
+AT_CHECK([$COMPILE_FIXED prog.cob], [1], [],
+[prog.cob:4: error: stray indicator 'E' (0x45): " EBad Indicator character in correct column"
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
@@ -109,7 +111,8 @@ AT_DATA([prog.cob], [ IDENTIFICATION DIVISION.
DISPLAY 'Should display'.
EXIT PROGRAM.
])
-AT_CHECK([$COMPILE_FIXED prog.cob], [1], [], [prog.cob:3: syntax error at 'Bad'
+AT_CHECK([$COMPILE_FIXED prog.cob], [1], [],
+[prog.cob:3: error: stray indicator '9' (0x39): " 9Bad Indicator character in correct column"
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
diff --git a/gcc/cobol/cdf_text.h b/gcc/cobol/cdf_text.h
index d93b82df32c63e5808d2bee0b3fa24edea2797b6..729c325572dd84a90b1b723ae5327235ce00d134 100644
--- a/gcc/cobol/cdf_text.h
+++ b/gcc/cobol/cdf_text.h
@@ -61,6 +61,7 @@ typedef std::pair <char *, std::list<std::string> > preprocessor_filter_t;
static std::list<preprocessor_filter_t> preprocessor_filters;
#include "lexio.h"
+#include "cbldiag.h"
#include <sys/types.h>
#include <sys/wait.h>
@@ -123,10 +124,12 @@ FILE *
cdftext::lex_open( const char filename[] ) {
int input = open_input( filename );
if( input == -1 ) return NULL;
- int output = open_output();
- filespan_t mfile( free_form_reference_format( input ) );
cobol_filename(filename, inode_of(input));
+
+ filespan_t mfile( free_form_reference_format( input ) );
+
+ int output = open_output();
process_file( mfile, output );
if( lexer_echo() ) {
@@ -365,11 +368,14 @@ cdftext::free_form_reference_format( int input ) {
break;
}
__attribute__ ((fallthrough));
- default: // ignore other characters in indicator area
- if( isspace(indcol[0])) break;
- warnx("warning: stray indicator 0x%0x \"%s\" %zu",
- indcol[0], indcol, mfile.lineno);
- *indcol = SPACE;
+ default: // flag other characters in indicator area
+ if( ! isspace(indcol[0]) ) {
+ yyerrorvl( mfile.lineno, cobol_filename(),
+ "error: stray indicator '%c' (0x%0x): \"%.*s\"",
+ indcol[0], indcol[0],
+ int(mfile.line_length() - 1), mfile.cur );
+ *indcol = SPACE;
+ }
break;
}
}
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index 6eddc2a4ee72703c083376fbb99898e886113b0c..90ef62a0cdac4196871694417579bb5bb8f63bac 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -227,6 +227,13 @@ LINE_DIRECTIVE [#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n
return NO_CONDITION;
}
+ {NAME}{SPC}AS { char *s = strdup(yytext);
+ char *p = strchr(s, 0x20);
+ assert(p); // just found via regex
+ *p = '\0';
+ ydflval.string = s;
+ return NAME;
+ }
{NAME} { ydflval.string = strdup(yytext);
return NAME;
}
@@ -1821,6 +1828,7 @@ COPY {
}
return token;
}
+ <*>[.][[:blank:].]+ { return '.'; }
}
<exception>{
@@ -1936,7 +1944,6 @@ COPY {
<*>OR { return OR; }
<*>AND { return AND; }
<*>[().=*/+&-] { return *yytext; }
-<*>[.][[:blank:].]+ { return '.'; }
<*>[[:blank:]]+
<*>\r?\n
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index f14071dceac8f2445dbd257bcca87f2337de95f5..4c095e62880c0c7abf2e8234602ac673f4c6cddf 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -448,8 +448,8 @@ picset( int token ) {
char *p = orig_picture + strlen(orig_picture);
if( eop < p + yyleng ) {
- yyerrorv("PICTURE '%s%s' exceeds maximum size of %zu bytes",
- p, yytext, sizeof(orig_picture) - 1);
+ yyerrorv("PICTURE exceeds maximum size of %zu bytes",
+ sizeof(orig_picture) - 1);
}
snprintf( p, eop - p, "%s", yytext );
return token;
diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h
index 74e794adb74642c6bcd3c0a77c672dd521afc07e..560b495782deeb71e23b47a6fbb33e80e0c7023d 100644
--- a/gcc/cobol/scan_post.h
+++ b/gcc/cobol/scan_post.h
@@ -239,10 +239,13 @@ prelex() {
// re-enter cdf parser if next token is a CDF token
}
+ if( YY_START == cdf_state && yy_top_state() == field_state ) {
+ yy_pop_state();
+ }
/*
* The final, rejected CDF token might be a LEVEL number.
*/
- if( YY_START == field_state && level_needed() ) {
+ if( YY_START == field_state && level_needed() ) {
if( token == final_token ) {
switch( token ) {
case NUMSTR:
@@ -256,6 +259,19 @@ prelex() {
token = LEVEL;
break;
}
+ if( token == LEVEL ) {
+ switch(yylval.number) {
+ case 66:
+ token = LEVEL66;
+ break;
+ case 78:
+ token = LEVEL78;
+ break;
+ case 88:
+ token = LEVEL78;
+ break;
+ }
+ }
}
}
@@ -319,8 +335,8 @@ yylex(void) {
token = prelex();
if( yy_flex_debug ) {
if( parsing.in_cdf() ) {
- warnx( "%s:%d: routing %s to CDF parser", __func__, __LINE__,
- keyword_str(token) );
+ warnx( "%s:%d: %s routing %s to CDF parser", __func__, __LINE__,
+ start_condition_is(), keyword_str(token) );
} else if( !parsing.on() ) {
yywarnv( "eating %s because conditional compilatiion is FALSE",
keyword_str(token) );