diff --git a/gcc/cobol/UAT/failsuite.src/cdf.at b/gcc/cobol/UAT/failsuite.src/cdf.at
index f5be5747efbf6a62e22e78638af61424ac66c647..822e6ccafd55a9dc64032c564183823b3773ab48 100644
--- a/gcc/cobol/UAT/failsuite.src/cdf.at
+++ b/gcc/cobol/UAT/failsuite.src/cdf.at
@@ -24,8 +24,9 @@ AT_BANNER([CDF Tests])
AT_SETUP([CDF2 Trouble with >>IF (1)])
AT_KEYWORDS([cdf define])
AT_DATA([prog.cob], [
- *> This compiles, but shouldn't; there should be no period after "prog"
- *> and there should be a period after INITIAL
+ *> This compiles correctly; there should be no period after "prog"
+ *> and there should be a period after INITIAL. But, IS INITIAL is
+ *> excluded because skip-init is not defined.
identification division.
program-id. prog.
>>IF skip-init IS DEFINED
@@ -42,7 +43,7 @@ AT_DATA([prog.cob], [
.
end program prog.
])
-AT_CHECK([$COMPILE prog.cob], [1], [], [])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CLEANUP
AT_SETUP([CDF2 Trouble with >>IF (2)])
@@ -66,6 +67,8 @@ AT_DATA([prog.cob], [
end program prog2.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([./a.out], [0], [], [])
+AT_CHECK([./a.out], [0], [0000000000000001
+6744073709550616
+], [])
AT_CLEANUP
diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index b616ddec6ede790075c71ff8dedf3ba121bd8f5d..1faaedb931be446d2d6e83cdbb8f1ab832363730 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -85,20 +85,32 @@ AT_DATA([prog.cob], [
STOP RUN.
])
-AT_CHECK([$COMPILE prog.cob], [0], [],
-[prog.cob:11: warning: FUNCTION 'FORMATTED-CURRENT-DATE' has format in variable
-prog.cob:18: warning: FUNCTION 'FORMATTED-DATE' has format in variable
-prog.cob:24: warning: FUNCTION 'FORMATTED-DATETIME' has format in variable
-prog.cob:31: warning: FUNCTION 'FORMATTED-TIME' has format in variable
-prog.cob:37: warning: FUNCTION 'INTEGER-OF-FORMATTED-DATE' has format in variable
-prog.cob:44: warning: FUNCTION 'SECONDS-FROM-FORMATTED-TIME' has format in variable
-prog.cob:51: warning: FUNCTION 'TEST-FORMATTED-DATETIME' has format in variable
+AT_CHECK([$COMPILE prog.cob], [1], [],
+[prog.cob:12: error: format must be literal at 'invalid-date-format'
+prog.cob:12: syntax error at 'invalid-date-format'
+prog.cob:16: syntax error at 'END-IF'
+prog.cob:18: error: format must be literal at 'invalid-date-format'
+prog.cob:18: syntax error at 'invalid-date-format'
+prog.cob:22: syntax error at 'END-IF'
+prog.cob:25: error: format must be literal at 'invalid-datetime-format'
+prog.cob:25: syntax error at 'invalid-datetime-format'
+prog.cob:25: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:29: syntax error at 'END-IF'
+prog.cob:31: error: format must be literal at 'invalid-time-format'
+prog.cob:31: syntax error at 'invalid-time-format'
+prog.cob:35: syntax error at 'END-IF'
+prog.cob:38: error: format must be literal at 'invalid-date-format'
+prog.cob:38: syntax error at 'invalid-date-format'
+prog.cob:42: syntax error at 'END-IF'
+prog.cob:45: error: format must be literal at 'invalid-time-format'
+prog.cob:45: syntax error at 'invalid-time-format'
+prog.cob:49: syntax error at 'END-IF'
+prog.cob:52: error: format must be literal at 'invalid-datetime-format'
+prog.cob:52: syntax error at 'invalid-datetime-format'
+prog.cob:56: syntax error at 'END-IF'
+cobol1: error: failed compiling prog.cob
])
-# running the program
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-
AT_CLEANUP
@@ -115,9 +127,9 @@ AT_DATA([prog.cob], [
MOVE E TO Z.
STOP RUN.
])
-AT_CHECK([$COMPILE prog.cob], [1], [], [prog.cob:8: syntax error: symbol 'PI' not found at 'TO'
-prog.cob:9: syntax error: symbol 'E' not found at 'TO'
-prog.cob:10: syntax error: symbol 'E' not found at 'TO'
+AT_CHECK([$COMPILE prog.cob], [1], [],
+[prog.cob:8: error: symbol 'PI' not found at 'TO'
+prog.cob:9: error: symbol 'E' not found at 'TO'
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
@@ -230,10 +242,9 @@ AT_DATA([prog.cob], [
.
END PROGRAM prog.
])
-AT_CHECK([$COMPILE -fnot-intrinsic=substitute prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[" _ C_O_B_O_L _ "
-" - C-O-B-O-L - "
+AT_CHECK([$COMPILE prog.cob], [1], [],
+[prog.cob:4: error: FUNCTION SUBSTITUTE is an intrinsic function
+cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
@@ -284,5 +295,79 @@ AT_DATA([prog.cob], [
DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThh:mm:ssZ" 128623 45296.987654321 -300).
END PROGRAM datetime.
])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COMPILE prog.cob], [1], [],
+[prog.cob:7: syntax error at ''
+prog.cob:7: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:8: syntax error at ''
+prog.cob:8: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:9: syntax error at ''
+prog.cob:9: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:10: syntax error at ''
+prog.cob:10: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:11: syntax error at ''
+prog.cob:11: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:12: syntax error at ''
+prog.cob:12: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:13: syntax error at ''
+prog.cob:13: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:14: syntax error at ''
+prog.cob:14: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:15: syntax error at ''
+prog.cob:15: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:16: syntax error at ''
+prog.cob:16: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:17: syntax error at ''
+prog.cob:17: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:18: syntax error at ''
+prog.cob:18: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:19: syntax error at ''
+prog.cob:19: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:20: syntax error at ''
+prog.cob:20: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:21: syntax error at ''
+prog.cob:21: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:22: syntax error at ''
+prog.cob:22: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:23: syntax error at ''
+prog.cob:23: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:24: syntax error at ''
+prog.cob:24: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:25: syntax error at ''
+prog.cob:25: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:26: syntax error at ''
+prog.cob:26: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:27: syntax error at ''
+prog.cob:27: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:28: syntax error at ''
+prog.cob:28: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:29: syntax error at ''
+prog.cob:29: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:30: syntax error at ''
+prog.cob:30: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:31: syntax error at ''
+prog.cob:31: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:32: syntax error at ''
+prog.cob:32: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:33: syntax error at ''
+prog.cob:33: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:34: syntax error at ''
+prog.cob:34: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:35: syntax error at ''
+prog.cob:35: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:36: syntax error at ''
+prog.cob:36: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:37: syntax error at ''
+prog.cob:37: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:38: syntax error at ''
+prog.cob:38: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:39: syntax error at ''
+prog.cob:39: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:40: syntax error at ''
+prog.cob:40: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:41: syntax error at ''
+prog.cob:41: error: FORMATTED_DATETIME: invalid parameter value at ')'
+prog.cob:42: syntax error at ''
+prog.cob:42: error: FORMATTED_DATETIME: invalid parameter value at ')'
+cobol1: error: failed compiling prog.cob
+])
AT_CLEANUP
diff --git a/gcc/cobol/UAT/failsuite.src/syn_misc.at b/gcc/cobol/UAT/failsuite.src/syn_misc.at
index a2fc97bcb66ccdcf2d40d5be9ddb4b8eddb90de6..74fd6908165ad2209a3dd7412486c99df7301d92 100644
--- a/gcc/cobol/UAT/failsuite.src/syn_misc.at
+++ b/gcc/cobol/UAT/failsuite.src/syn_misc.at
@@ -36,7 +36,11 @@ AT_DATA([prog.cob], [
X"1"
END-DISPLAY.
])
-AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [Needs better error messages])
+AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [prog.cob:9: error: invalid hexadecimal value: X"GH" at 'X"GH"'
+prog.cob:9: syntax error at 'X"GH"'
+prog.cob:10: syntax error: hex literal '1' has an odd number (1) of characters at '1'
+cobol1: error: failed compiling prog.cob
+])
AT_CLEANUP
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index c39d84f26fbc171fa42cdad9e0e778568f3d248b..783f01343fc8e713635c00cf9f9013ee9c84bc81 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -1008,6 +1008,11 @@ function_id: FUNCTION '.' NAME program_as program_attrs[attr] '.'
$NAME, L->line);
YYERROR;
}
+ if( keyword_tok($NAME, true) ) {
+ yyerrorv("error: FUNCTION %s is an intrinsic function",
+ $NAME);
+ YYERROR;
+ }
current.udf_add(current_program_index());
if( nparse_error > 0 ) YYABORT;
}
@@ -3874,6 +3879,10 @@ type_clause: TYPE to typename
typedef_clause: is TYPEDEF strong
{
cbl_field_t *field = current_field();
+ if( field->level != 1 ) {
+ yyerrorv("error: %02d %s IS TYPEDEF must be level 01",
+ field->level, field->name);
+ }
field->attr |= typedef_e;
if( $strong ) field->attr |= strongdef_e;
yywarn("warning: TYPEDEF is provisional");
@@ -5331,16 +5340,14 @@ refmod: LPAREN expr[from] ':' expr[len] ')' %prec NAME
}
;
-typename: qname
+typename: NAME
{
- auto e = symbol_typedef(PROGRAM, names);
+ auto e = symbol_typedef(PROGRAM, $NAME);
if( ! e ) {
- yyerrorv("error: symbol '%s' not found", names.back() );
- names.clear();
+ yyerrorv("error: symbol '%s' not found", $NAME );
YYERROR;
}
$$ = cbl_field_of(e);
- names.clear();
}
;
@@ -8707,6 +8714,10 @@ intrinsic: function_udf
if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
r1, $r2, $r3, $r4) ) YYERROR;
}
+ | FORMATTED_DATETIME '(' error ')' {
+ yyerror("error: FORMATTED_DATETIME: invalid parameter value");
+ YYERROR;
+ }
| FORMATTED_TIME '(' TIME_FMT[r1] expr[r2]
expr[r3] ')' {
location_set(@1);
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index 3cdfd0f75317665a1d1dfb19bfd0c41df2b0cb64..a84b366a7f5e09ef605918132fbe96133730b4eb 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -58,6 +58,7 @@ hfc (({hpref}{hfrac}{bexp}{fsuff_opt})|({hpref}{hdseq}{bexp}{fsuff_opt}))
boolseq (([''][01]+[''])|([""][01]+[""]))
hexseq ((['']{hdseq}[''])|([""]{hdseq}[""]))
+nonseq (([''][[:alnum:]]+][''])|([""][[:alnum:]]+[""]))
INTEGER 0*[1-9][[:digit:]]*
INTEGERZ [[:digit:]]+
@@ -1076,6 +1077,8 @@ USE({SPC}FOR)? { return USE; }
yy_push_state(quoted2); }
N?X/{hexseq} { yylval.literal.set_prefix(yytext, yyleng);
yy_push_state(hex_state); }
+ N?X{nonseq} { yyerrorv("error: invalid hexadecimal value: %s", yytext);
+ return NO_CONDITION; }
[[:blank:]]*\r?\n {}
WORKING-STORAGE{SECTION} { return WORKING_STORAGE_SECT; }
@@ -1252,7 +1255,7 @@ USE({SPC}FOR)? { return USE; }
<program_id_state>{
^[[:blank:]]+
^{BLANK_EOL}
- (IS)?{SPC}
+ (IS)?[[:space:]]
COMMON/[.]|{SPC}[[:alnum:].] { return COMMON; }
INITIAL/[.]|{SPC}[[:alnum:].] { return INITIAL_kw; }
@@ -1309,6 +1312,9 @@ USE({SPC}FOR)? { return USE; }
B/{boolseq} { is_not = false; yy_push_state(bool_state); }
N?X/{hexseq} { yylval.literal.set_prefix(yytext, yyleng);
yy_push_state(hex_state); }
+ N?X{nonseq} { yyerrorv("error: invalid hexadecimal value: %s", yytext);
+ return NO_CONDITION; }
+
BX/{hexseq} { yylval.numstr.radix = hexadecimal_e;
yy_push_state(numstr_state); }
@@ -1547,29 +1553,47 @@ USE({SPC}FOR)? { return USE; }
<datetime_fmt>{
[(] { return *yytext; }
- ['']{DATETIME_FMT}[''] { yylval.string = strdup(yytext + 1);
- yylval.string[yyleng-2] = '\0';
- pop_return DATETIME_FMT; }
+ ['']{DATETIME_FMT}[''] |
[""]{DATETIME_FMT}[""] { yylval.string = strdup(yytext + 1);
yylval.string[yyleng-2] = '\0';
pop_return DATETIME_FMT; }
- ['']{DATE_FMT}[''] { yylval.string = strdup(yytext + 1);
- yylval.string[yyleng-2] = '\0';
- pop_return DATE_FMT; }
+ ['']{DATE_FMT}[''] |
[""]{DATE_FMT}[""] { yylval.string = strdup(yytext + 1);
yylval.string[yyleng-2] = '\0';
pop_return DATE_FMT; }
- ['']{TIME_FMT}[''] { yylval.string = strdup(yytext + 1);
- yylval.string[yyleng-2] = '\0';
- pop_return TIME_FMT; }
+ ['']{TIME_FMT}[''] |
[""]{TIME_FMT}[""] { yylval.string = strdup(yytext + 1);
yylval.string[yyleng-2] = '\0';
pop_return TIME_FMT; }
{SPC} // ignore
- . { return NO_CONDITION; }
+ {NAME} {
+ int token = NO_CONDITION;
+ char type = 0;
+ auto elem = symbol_field(PROGRAM, 0, yytext);
+
+ if( elem->type == SymField ) {
+ auto f = cbl_field_of(elem);
+ if( f->type == FldLiteralA && f->has_attr(constant_e) ) {
+ type = date_time_fmt(f->data.initial);
+ yylval.string = strdup(f->data.initial);
+ }
+ }
+ switch(type) {
+ case 'D': token = DATETIME_FMT; break;
+ case 'd': token = DATE_FMT; break;
+ case 't': token = TIME_FMT; break;
+ default:
+ yyerror("error: format must be literal");
+ pop_return token;
+ break;
+ }
+ pop_return token;
+ }
+
+ . { yyless(0); pop_return NO_CONDITION; }
}
<function>{
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 2c5c98a084bccebae9f6c5ab388f42be60468400..0d2a4a0e23803e0c1c0bd7d1c5811aba1bbaf090 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -269,8 +269,14 @@ static const struct cbl_field_t empty_comp5 = {
0, 0, 0, nonarray, 0, "",
0, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL, NULL, {NULL}, {NULL}}, NULL };
+#if 0
+# define CONSTANT_E constant_e
+#else
+# define CONSTANT_E temporary_e
+#endif
+
static struct cbl_field_t empty_literal = {
- 0, FldInvalid, FldInvalid, temporary_e,
+ 0, FldInvalid, FldInvalid, CONSTANT_E,
0, 0, 0, nonarray, 0, "",
0, {0,0,0,0, NULL, NULL, {NULL}, {NULL}}, NULL };
@@ -1789,40 +1795,11 @@ symbols_update( size_t first, bool parsed_ok ) {
if( field->level == 0 && field->is_key_name() ) continue;
if( is_literal(field) && field->var_decl_node != NULL ) continue;
-#if 1
if( field->is_typedef() ) {
auto isym = end_of_group( symbol_index(p) );
p = symbol_at(--isym);
continue;
}
-#else
- if( 1 < field->level && field->is_typedef() ) {
- if( field->parent ) {
- auto e = symbol_at(field->parent);
- if( e->type == SymField ) {
- auto parent = cbl_field_of(e);
- p = end_of_group( parent, field );
- p--;
- continue;
- }
- warnx("%s:%s: odd: %s is TYPEDEF and has non-field parent %s",
- __func__, __LINE__, field->name, symbol_type_str(e->type));
- }
- p = std::find(++p, symbols_end(),
- []( auto& e ) {
- if( e->type == SymField ) {
- auto f = cbl_field_of(e);
- switch( f->level ) {
- case 1: case 66: case 77: case 88:
- return true;
- }
- }
- return false;
- } );
- p--;
- continue;
- }
-#endif
// Verify REDEFINing field has no ODO components
auto parent = symbol_redefines(field);
@@ -1839,6 +1816,7 @@ symbols_update( size_t first, bool parsed_ok ) {
continue;
}
+ assert( ! field->is_typedef() );
if( parsed_ok ) parser_symbol_add(field);
}
@@ -2462,33 +2440,21 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
* TYPEDEF is relevant only in Data Division.
*/
struct symbol_elem_t *
-symbol_typedef_DNU( size_t program, size_t parent, const char name[] )
+symbol_typedef( size_t program, const char name[] )
{
- class match_field {
- size_t program, parent;
- const char *name;
- public:
- match_field( size_t program, size_t parent, const char name[] )
- : program(program)
- , parent(parent)
- , name(name)
- {}
- bool operator()( const symbol_elem_t& sym ) const {
- if( sym.type != SymField ) return false;
- if( sym.program != program ) return false;
-
- const auto& field = *cbl_field_of(&sym);
-
- if( parent > 0 && parent != field.parent ) return false;
- if( ! field.is_typedef() ) return false;
-
- return 0 == strcasecmp(name, field.name);
- }
- };
-
auto beg = std::reverse_iterator<symbol_elem_t *>(symbols_end());
auto end = std::reverse_iterator<symbol_elem_t *>(symbols_begin(program));
- auto p = std::find_if( beg, end, match_field(program, parent, name) );
+
+ auto p = std::find_if( beg, end,
+ [name]( const symbol_elem_t& sym ) {
+ if( sym.type == SymField ) {
+ auto f = cbl_field_of(&sym);
+ if( f->has_attr(typedef_e) ) {
+ return 0 == strcasecmp(name, f->name);
+ }
+ }
+ return false;
+ } );
return p != end? &*p : NULL;
}
@@ -2982,12 +2948,9 @@ new_temporary_impl( enum cbl_field_type_t type )
*f = empty_conditional;
break;
case FldLiteralA:
- *f = empty_literal;
- f->type = FldLiteralA;
- break;
case FldLiteralN:
*f = empty_literal;
- f->type = FldLiteralN;
+ f->type = type;
break;
case FldNumericBin5:
case FldNumericBinary:
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 17ca9f3fc9fc5703bd6a4bb58615849444296f14..bd7f26b0cfc3f0088718aa310b45afc928e7d0af 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -2082,16 +2082,18 @@ const char * cobol_lineno_save();
char *cobol_name_mangler(const char *cobol_name);
bool is_elementary( enum cbl_field_type_t type );
-
bool is_numeric_edited( const char picture[] );
const char * intrinsic_function_name( int token );
+char date_time_fmt( const char input[] );
+
size_t current_program_index();
const char * current_declarative_section_name();
struct symbol_elem_t * symbol_typedef( size_t program, std::list<const char *> names );
+struct symbol_elem_t * symbol_typedef( size_t program, const char name[] );
struct symbol_elem_t * symbol_field( size_t program,
size_t parent, const char name[] );
struct cbl_label_t * symbol_program( size_t parent, const char name[] );
diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc
index 3100e4054b75de17ec48a559b28b87156f1d99dd..2cb4eec84a19bcaffdeafa50761482f6f5350637 100644
--- a/gcc/cobol/symfind.cc
+++ b/gcc/cobol/symfind.cc
@@ -385,8 +385,7 @@ size_t end_of_group( size_t igroup );
static std::vector<size_t>
symbol_match2( size_t program,
- std::list<const char *> names,
- bool local = true, bool want_type = false )
+ std::list<const char *> names, bool local = true )
{
std::vector<size_t> fields;
@@ -397,23 +396,19 @@ symbol_match2( size_t program,
if( e->program != program ) break;
if( e->type != SymField ) continue;
- bool right_kind = ( want_type && is_typedef(e)) ||
- (!want_type && !is_typedef(e));
-#if 0
- if( !right_kind ) {
+ if( is_typedef(e) ) {
auto isym = end_of_group( symbol_index(e) );
e = symbol_at(--isym);
continue;
}
-#endif
- if( right_kind && name_has_names( e, names, local ) ) {
+ if( name_has_names( e, names, local ) ) {
fields.push_back( symbol_index(e) );
}
}
if( fields.empty() ){
- if( program > 0 && !want_type ) { // try containing program
+ if( program > 0 ) { // try containing program
program = cbl_label_of(symbol_at(program))->parent;
return symbol_match2( program, names, program == 0 );
}
@@ -473,6 +468,7 @@ symbol_match( size_t program, std::list<const char *> names ) {
return output;
}
+#if 0
struct symbol_elem_t *
symbol_typedef( size_t program, std::list<const char *> names ) {
auto types = symbol_match2(program, names, true, true);
@@ -483,6 +479,7 @@ symbol_typedef( size_t program, std::list<const char *> names ) {
}
return symbol_at( types.front() );
}
+#endif
std::pair <symbol_elem_t *, bool>
symbol_find( size_t program, std::list<const char *> names ) {
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index f3fea330f31633692db27631e1e871d8e0da7101..dfbbc7a89020f2adbf1a9b7f3f5feb30d061d956 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -1840,6 +1840,60 @@ name_space_kw( const char input[], int *token ) {
return keyword_of(candidate)? len1 : 0; // 1st is NAME, 2nd is keyword
}
+char
+date_time_fmt( const char input[] ) {
+ if( ! input ) return 0;
+
+#define DATE_FMT_B "(YYYYMMDD|YYYYDDD|YYYYWwwD)"
+#define DATE_FMT_E "(YYYY-MM-DD|YYYY-DDD|YYYY-Www-D)"
+#define TIME_FMT1 "hhmmss([.,]s+)?"
+#define TIME_FMT3 "hhmmss([.,]s+)?Z"
+#define TIME_FMT5 "hhmmss([.,]s+)?[+]hhmm"
+#define TIME_FMT2 "hh:mm:ss([.,]s+)?"
+#define TIME_FMT4 "hh:mm:ss([.,]s+)?Z"
+#define TIME_FMT6 "hh:mm:ss([.,]s+)?[+]hh:mm"
+
+#define TIME_FMT_B "(" TIME_FMT1 "|" TIME_FMT3 "|" TIME_FMT5 ")"
+#define TIME_FMT_E "(" TIME_FMT2 "|" TIME_FMT4 "|" TIME_FMT6 ")"
+
+ static bool compiled = false;
+ static struct fmts_t {
+ regex_t reg; char type; char pattern[256];
+ } fmts[] = {
+ { regex_t(), 'D', "^((" DATE_FMT_B "T" TIME_FMT_B ")|("
+ DATE_FMT_E "T" TIME_FMT_E "))$" },
+ { regex_t(), 'd', "^(" DATE_FMT_B "|" DATE_FMT_E ")$" },
+ { regex_t(), 't', "^(" TIME_FMT_B "|" TIME_FMT_E ")$" },
+ };
+ int erc, cflags = REG_EXTENDED | REG_ICASE, eflags=0;
+ regmatch_t m[5];
+ char result = 0;
+
+ if( ! compiled ) {
+ for( auto& fmt : fmts ) {
+ ////warnx( "%s: %c, %s", __func__, fmt.type, fmt.pattern );
+ if( (erc = regcomp(&fmt.reg, fmt.pattern, cflags)) != 0 ) {
+ char msg[80];
+ regerror(erc, &fmt.reg, msg, sizeof(msg));
+ errx( EXIT_FAILURE, "%s: regcomp: %s", __func__, msg );
+ }
+ }
+ compiled = true;
+ }
+
+ ////warnx("%s: input '%s'", __func__, input);
+ for( auto& fmt : fmts ) {
+ if( 0 == regexec(&fmt.reg, input, COUNT_OF(m), m, eflags) ) {
+ result = fmt.type;
+ break;
+ }
+ }
+
+ return result;
+}
+
+
+
/*
* Development suppport
*/