diff --git a/gcc/cobol/UAT/testsuite.src/run_regression.at b/gcc/cobol/UAT/testsuite.src/run_regression.at
index d7e99431f18cffaf1197f0831aa5e40e6cfceb4d..09a4ffef889c2206d42579d7412db57278867cb9 100644
--- a/gcc/cobol/UAT/testsuite.src/run_regression.at
+++ b/gcc/cobol/UAT/testsuite.src/run_regression.at
@@ -333,10 +333,10 @@ AT_DATA([prog.cob], [ IDENTIFICATION DIVISION.
DISPLAY VAR1 SPACE VAR2 SPACE VAR3
GOBACK.
])
-AT_CHECK([$COMPILE prog.cob], [1], [], [prog.cob:5: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(7)V9(0)'
-prog.cob:6: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(7)V9(0)'
-prog.cob:7: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(7)V9(0)'
-prog.cob:8: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(7)V9(0)'
+AT_CHECK([$COMPILE prog.cob], [1], [], [prog.cob:5: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(0)'
+prog.cob:6: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(0)'
+prog.cob:7: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(0)'
+prog.cob:8: error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3) at '9(0)'
prog.cob:9: 4 errors in DATA DIVISION, compilation ceases at 'PROCEDURE DIVISION'
cobol1: error: failed compiling prog.cob
])
diff --git a/gcc/cobol/UAT/testsuite.src/syn_definition.at b/gcc/cobol/UAT/testsuite.src/syn_definition.at
index 26706ea59d054ca28f5a704f845c78c1a09b8a49..3000c2a64850000267bcb62fdbb6ffa4e4aeec29 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_definition.at
@@ -465,10 +465,11 @@ prog.cob:40: invalid picture for Alphanumeric-edited at 'NX'
prog.cob:41: invalid picture for Alphanumeric-edited at 'AN'
prog.cob:42: invalid picture for Alphanumeric-edited at 'AZ(3)'
prog.cob:44: invalid picture for Alphanumeric-edited at 'SA'
-prog.cob:67: invalid picture for Alphanumeric-edited at 'X(str-constant)'
-prog.cob:68: invalid picture for Alphanumeric-edited at 'X(float-constant)'
-prog.cob:69: invalid picture for Alphanumeric-edited at 'X(signed-constant)'
-prog.cob:70: invalid picture for Alphanumeric-edited at 'X(unseen-constant)'
+prog.cob:67: error: PICTURE '(str-constant)' requires a CONSTANT value at ')'
+prog.cob:69: error: invalid PICTURE count '(-1.00000000000000000000000000000000E+00)' at ')'
+prog.cob:69: error: invalid PICTURE count '(signed-constant)' at ')'
+prog.cob:69: error: PICTURE count '(-1)' is negative at ')'
+prog.cob:70: error: PICTURE '(unseen-constant)' requires a CONSTANT value at ')'
prog.cob:80: invalid picture for Alphanumeric-edited at '$(integer-constant)'
prog.cob:81: invalid picture for Alphanumeric-edited at '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$(integer-constant)'
prog.cob:86: error: unimplemented USAGE type: BIT at 'BIT'
@@ -489,7 +490,7 @@ prog.cob:93: error: unimplemented USAGE type: BIT at 'BIT'
prog.cob:93: syntax error at 'BIT'
prog.cob:96: error: unimplemented USAGE type: BIT at 'BIT'
prog.cob:96: syntax error at 'BIT'
-.:97: 43 errors in DATA DIVISION, compilation ceases detected at end of file
+.:97: 44 errors in DATA DIVISION, compilation ceases detected at end of file
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
diff --git a/gcc/cobol/cdfval.h b/gcc/cobol/cdfval.h
index b99847801eab82d287838469e5b9ae631af42123..aa98e1bd53b4229c1d598f71861f712193870551 100644
--- a/gcc/cobol/cdfval.h
+++ b/gcc/cobol/cdfval.h
@@ -32,6 +32,7 @@
#ifndef _CDF_VAL_H_
#define _CDF_VAL_H_
+#include <assert.h>
#include <stdint.h>
#include <stdlib.h>
@@ -78,6 +79,9 @@ struct cdfval_t : public cdfval_base_t {
cdfval_base_t *self(this);
*self = value;
}
+
+ bool is_numeric() const { return ! (off || string); }
+ int64_t as_number() const { assert(is_numeric()); return number; }
};
bool
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 5be51cf8ee42e4cb7e863d1c3278f605a3efd15e..ee779e10b88d3d4c49f579492b49463541697e52 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -3517,6 +3517,10 @@ alphanum_part: ALNUM[picture] count
--$count;
$$.nbyte += $count; // AX9(3) has count 5
}
+ if( $count < 0 ) {
+ yyerrorv("error: PICTURE count '(%d)' is negative", $count );
+ YYERROR;
+ }
}
;
@@ -3530,12 +3534,42 @@ nps: %empty { $$ = 0; }
nine: %empty { $$ = 0; }
| NINES
+ {
+ $$ = $1;
+ if( $$ == 0 ) {
+ yyerror("error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3)");
+ }
+ }
;
count: %empty { $$ = 0; }
| '(' NUMSTR ')'
{
$$ = numstr2i( $NUMSTR.string, $NUMSTR.radix );
+ if( $$ == 0 ) {
+ yyerror("error: '(0)' invalid in PICTURE (ISO 2023 13.18.40.3)");
+ }
+ }
+ | '(' NAME ')'
+ {
+ auto value = cdf_value($NAME);
+ if( ! (value && value->is_numeric()) ) {
+ yyerrorv("error: PICTURE '(%s)' requires a CONSTANT value", $NAME );
+ YYERROR;
+ }
+ auto e = symbol_field(PROGRAM, 0, $NAME);
+ if( e ) { // verify not floating point with nonzero fraction
+ auto field = cbl_field_of(e);
+ assert(is_literal(field));
+ if( field->data.value != size_t(field->data.value) ) {
+ yyerrorv("error: invalid PICTURE count '(%s)'",
+ field->data.initial );
+ }
+ }
+ $$ = value->as_number();
+ if( $$ <= 0 ) {
+ yyerrorv("error: invalid PICTURE count '(%s)'", $NAME );
+ }
}
;
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index 10cb2654caa41aa386eaff7c52c6b377d2415bf9..2eb0373408949b3d89de10440773fda235ff1a54 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -76,7 +76,7 @@ DOTEOL [[:blank:]]*[.]{BLANK_EOL}
SKIP [[:blank:]]*SKIP[123][[:blank:]]*[.]?{BLANK_EOL}
TITLE [[:blank:]]*TITLE($|[.]|[^\n]*)
-COUNT [(]0*[1-9][0-9]*[)]
+COUNT [(][[:digit:]]+[)]
N9 9+|(9{COUNT})
NP P+|(P{COUNT})
@@ -1149,6 +1149,8 @@ USE({SPC}FOR)? { return USE; }
{ALNUM}/{COUNT} { yy_push_state(picture_count);
yylval.string = strdup(yytext); return picset(ALNUM); }
+ {ALNUM}/[(]{NAME}[)] { yy_push_state(picture_count);
+ yylval.string = strdup(yytext); return picset(ALNUM); }
{ALNUM} { yylval.string = strdup(yytext); return picset(ALNUM); }
{ALPHED} { yylval.string = strdup(yytext); return picset(ALPHED); }
@@ -1166,10 +1168,11 @@ USE({SPC}FOR)? { return USE; }
}
<picture_count>{
- [[:blank:]]+ { /* skip */ }
- [(]/[[:blank:]]*[[:digit:]] { return picset(*yytext); }
- {INTEGER}/[[:blank:]]*[)] { return picset(numstr_of(yytext)); }
- [)] { pop_return picset(*yytext); }
+ [(] { return picset(*yytext); }
+ [)] { pop_return picset(*yytext); }
+ {INTEGER} { return picset(numstr_of(yytext)); }
+ {NAME} { yylval.string = strdup(yytext);
+ return picset(NAME); }
}
<integer_count>{
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index 694fef8e3d3c6c77f00323226c24867256831da8..f114293716bc049e73540555cdd32184166cee57 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -376,11 +376,11 @@ static inline int
ndigit(int len) {
char *input = toupper(yytext[0]) == 'V'? yytext + 1 : yytext;
int n = repeat_count(input);
- return n? n : len;
+ return n == -1? len : n;
}
static int
-picset( int ret ) {
+picset( int token ) {
static const char * const eop = orig_picture + sizeof(orig_picture);
char *p = orig_picture + strlen(orig_picture);
@@ -388,7 +388,7 @@ picset( int ret ) {
yyerrorv("PICTURE exceeds maximum size of %zu bytes", sizeof(orig_picture) - 1);
}
snprintf( p, eop - p, "%s", yytext );
- return ret;
+ return token;
}
static inline bool
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index 7c2e63b3e375dbc92d7962f08afdb98423ae6a59..f47a43e6d303906c0d3b4139e1a84f0083468557 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -201,10 +201,13 @@ int
repeat_count( const char picture[] )
{
char ch;
- int n = 0;
+ int n, count = -1;
- sscanf( picture, "%c(%d)", &ch, &n );
- return n;
+ n = sscanf( picture, "%c(%d)", &ch, &count );
+ if( count <= 0 && 4 < n ) { // parsed count is negative
+ count = 0; // zero is invalid; -1 means no repetition
+ }
+ return count;
}
const char *numed_message;