Skip to content

Commit

Permalink
Merge SVN 5093
Browse files Browse the repository at this point in the history
  • Loading branch information
ddeclerck committed Jan 10, 2025
1 parent b8a3783 commit a0d4a56
Show file tree
Hide file tree
Showing 6 changed files with 222 additions and 53 deletions.
7 changes: 7 additions & 0 deletions cobc/ChangeLog
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,13 @@
(next_word_is_comment_paragraph_name): decrease stack storage
and optimize string comparisons

2023-06-20 Fabrice Le Fessant <[email protected]>

* typeck.c (cb_build_expr): fix bug #875 "V IS ZERO AND
... generate 'invalid conditional expression' error",
fix bug #880 error compiling abbreviated conditions in GC3.2 RC2
(NOT comparison should be translated to inversed comparison)

2023-06-20 Fabrice Le Fessant <[email protected]>

* typeck.c (cb_build_expr): remove cb_ prefix from static functions
Expand Down
10 changes: 7 additions & 3 deletions cobc/tree.c
Original file line number Diff line number Diff line change
Expand Up @@ -6504,16 +6504,20 @@ cb_build_binary_op (cb_tree x, const enum cb_binary_op_op op, cb_tree y)
case ']':
rel_bin_op = 1;
/* Relational operators */
#if 0 /* note: already tested in the parser with (check_not_88_level) */
if ((CB_REF_OR_FIELD_P (x))
&& CB_FIELD_PTR (x)->level == 88) {
cb_error_x (e, _("invalid expression"));
/* because this code is not active and the translation would be new,
we don't have that gettextized */
cb_error_x (e, "invalid expression: conditional on the left of numeric operator");
return cb_error_node;
}
if ((CB_REF_OR_FIELD_P (y))
&& CB_FIELD_PTR (y)->level == 88) {
cb_error_x (e, _("invalid expression"));
cb_error_x (e, "invalid expression: conditional on the right of numeric operator");
return cb_error_node;
}
#endif

if (x == cb_zero) {
xl = CB_LITERAL(cb_zero_lit);
Expand Down Expand Up @@ -6742,7 +6746,7 @@ cb_build_binary_op (cb_tree x, const enum cb_binary_op_op op, cb_tree y)
cb_error_x (e, _("invalid expression: %s %s %s"),
llit, explain_operator (op), rlit);
} else {
cb_error_x (e, _("invalid expression"));
cb_error_x (e, _("invalid expression: boolean expected with logical operator"));
}
return cb_error_node;
}
Expand Down
72 changes: 49 additions & 23 deletions cobc/typeck.c
Original file line number Diff line number Diff line change
Expand Up @@ -6134,21 +6134,22 @@ build_expr_finish (void)
/* Reduce all (prio of token 0 is smaller than all other ones) */
(void)build_expr_reduce (0);

if (!expr_stack[TOPSTACK].value) {
/* TODO: Add test case for this to syn_misc.at invalid expression */
cb_error (_("invalid expression"));
return cb_error_node;
}

SET_SOURCE(expr_stack[TOPSTACK].value, cb_source_file, cb_exp_line);

if (expr_index != TOPSTACK+1) {
cb_error_x (expr_stack[TOPSTACK].value, _("invalid expression"));
cb_error_x (expr_stack[TOPSTACK].value, _("invalid expression: unfinished expression"));
return cb_error_node;
}

if (!expr_stack[TOPSTACK].value) {
/* TODO: Add test case for this to syn_misc.at invalid expression */
cb_error (_("invalid expression"));
return cb_error_node;
}

build_expr_expand (&expr_stack[TOPSTACK].value);
if (expr_stack[TOPSTACK].token != 'x') {
/* TODO: add a test case, for now, no idea how to reach this */
cb_error_x (expr_stack[TOPSTACK].value, _("invalid expression"));
return cb_error_node;
}
Expand Down Expand Up @@ -6215,8 +6216,22 @@ cb_build_expr (cb_tree list)
has_rel = 1;
break;
default:
if(TOKEN (-1) == '!'){
/* switch `NOT` relation, e.g. the two expression tokens `NOT` and `>`
* are reduced to a single token `<=` */
switch(op){
case '=': TOKEN (-1) = '~'; continue;
case '>': TOKEN (-1) = '['; continue;
case '<': TOKEN (-1) = ']'; continue;
case ']': TOKEN (-1) = '<'; continue;
case '[': TOKEN (-1) = '>'; continue;
}
}
v = CB_VALUE (l);
if (op == 'x') {
if( has_var && v == cb_zero ){
has_rel = 1;
}
has_var = 1;
if (CB_TREE_TAG (v) == CB_TAG_BINARY_OP) {
has_rel = 1;
Expand Down Expand Up @@ -6608,9 +6623,10 @@ decimal_compute (const int op, cb_tree x, cb_tree y)
}

/**
* expand tree x to the previously allocated decimal tree d
* expand tree x to the previously allocated decimal tree d.
* Returns either d or cb_error_node in case of error.
*/
static void
static cb_tree
decimal_expand (cb_tree d, cb_tree x)
{
struct cb_literal *l;
Expand All @@ -6621,7 +6637,7 @@ decimal_expand (cb_tree d, cb_tree x)
/* skip if the actual statement can't be generated any more
to prevent multiple errors here */
if (error_statement == current_statement) {
return;
return d;
}
switch (CB_TREE_TAG (x)) {
case CB_TAG_CONST:
Expand Down Expand Up @@ -6695,21 +6711,30 @@ decimal_expand (cb_tree d, cb_tree x)
* Set t, Y
* OP d, t */
p = CB_BINARY_OP (x);
if ((p->op == 'c' || p->op == 'd') /* Circular Shift */
&& CB_REF_OR_FIELD_P (p->x)) {
sz_shift = cb_int (CB_FIELD_PTR (p->x)->size);
} else {
sz_shift = cb_int1;

switch (p->op){
case '=': case '~': case '<': case '>': case '[': case ']':
case '!': case '&': case '|':
cb_error_x (x, "condition expression found where decimal expression was expected");
error_statement = current_statement;
return cb_error_node;
case 'c':
case 'd':
if (CB_REF_OR_FIELD_P (p->x)) {
sz_shift = cb_int (CB_FIELD_PTR (p->x)->size);
break;
}
default: sz_shift = cb_int1;
}
decimal_expand (d, p->x);
d = decimal_expand (d, p->x);

if (CB_TREE_TAG (p->y) == CB_TAG_LITERAL
&& CB_TREE_CATEGORY (p->y) == CB_CATEGORY_NUMERIC) {
t = cb_build_decimal_literal (cb_lookup_literal(p->y,1));
decimal_compute (p->op, d, t);
} else {
t = decimal_alloc ();
decimal_expand (t, p->y);
t = decimal_expand (t, p->y);
decimal_compute (p->op, d, t);
decimal_free ();
}
Expand All @@ -6724,6 +6749,7 @@ decimal_expand (cb_tree d, cb_tree x)
CB_TREE_TAG_UNEXPECTED_ABORT (x);
/* LCOV_EXCL_STOP */
}
return d;
}

static void
Expand Down Expand Up @@ -6816,7 +6842,7 @@ build_decimal_assign (cb_tree vars, const int op, cb_tree val)
d = decimal_alloc ();

/* Set d, VAL */
decimal_expand (d, val);
d = decimal_expand (d, val);

s1 = NULL;
if (op == 0) {
Expand All @@ -6838,7 +6864,7 @@ build_decimal_assign (cb_tree vars, const int op, cb_tree val)
* OP t, d
* set VAR <- t, with appropriate rounding
*/
decimal_expand (t, CB_VALUE (l));
t = decimal_expand (t, CB_VALUE (l));
decimal_compute (op, t, d);
decimal_assign (CB_VALUE (l), t, CB_PURPOSE (l));
s2 = cb_list_reverse (decimal_stack);
Expand Down Expand Up @@ -7407,8 +7433,8 @@ cb_build_cond_default (struct cb_binary_op *p, cb_tree left, cb_tree right)
}
d1 = decimal_alloc ();
d2 = decimal_alloc ();
decimal_expand (d1, left);
decimal_expand (d2, right);
d1 = decimal_expand (d1, left);
d2 = decimal_expand (d2, right);
dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_cmp", d1, d2));
decimal_free ();
decimal_free ();
Expand Down Expand Up @@ -7570,7 +7596,7 @@ cb_build_cond (cb_tree x)
if (x != cb_any && x != cb_true && x != cb_false) {
/* TODO: Add test case for this to syn_misc.at invalid expression */
cb_error_x (CB_TREE(current_statement),
_("invalid expression"));
_("invalid expression: condition expected"));
return cb_error_node;
}
return x;
Expand Down Expand Up @@ -7641,7 +7667,7 @@ cb_build_cond (cb_tree x)
default:
break;
}
cb_error_x (x, _("invalid expression"));
cb_error_x (x, _("incomplete expression"));
return cb_error_node;
}

Expand Down
117 changes: 117 additions & 0 deletions tests/testsuite.src/run_fundamental.at
Original file line number Diff line number Diff line change
Expand Up @@ -6463,3 +6463,120 @@ AT_CHECK([$COBCRUN_DIRECT ./packed], [0],
], [])

AT_CLEANUP


AT_SETUP([Condition IS ZERO AND])
AT_KEYWORDS([IF])

# for more details see bug #875

AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 V PIC 9 VALUE 0.
01 W PIC 9 VALUE 1.
PROCEDURE DIVISION.
IF V IS ZERO
DISPLAY "V IS ZERO"
END-IF.
IF V IS ZERO AND W EQUAL 1
DISPLAY "V IS ZERO AND W EQUAL 1"
END-IF.
IF W EQUAL 1 AND V IS ZERO
DISPLAY "W EQUAL 1 AND V IS ZERO"
END-IF.
IF W IS POSITIVE
DISPLAY "W IS POSITIVE"
END-IF.
IF W IS NEGATIVE
DISPLAY "W IS NEGATIVE"
END-IF.
IF W IS POSITIVE AND V EQUAL 0
DISPLAY "W IS POSITIVE AND V EQUAL 0"
END-IF.
IF V EQUAL 0 AND W IS POSITIVE
DISPLAY "V EQUAL 0 AND W IS POSITIVE"
END-IF.
])

AT_CHECK([$COMPILE prog.cob], [0], [],
[prog.cob:21: warning: unsigned 'W' may not be LESS THAN ZERO
])

AT_CHECK([./prog], [0], [V IS ZERO
V IS ZERO AND W EQUAL 1
W EQUAL 1 AND V IS ZERO
W IS POSITIVE
W IS POSITIVE AND V EQUAL 0
V EQUAL 0 AND W IS POSITIVE
], [])

AT_CLEANUP


AT_SETUP([abbreviated conditions with multiple words operators])
AT_KEYWORDS([IF])

# for more details see bug #880

AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. CHECKBOOL.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VAR1 PIC X(16) VALUE "#0001".
01 VAR2 PIC X(16) VALUE "#0002".
01 VAR3 PIC X(16) VALUE "#0003".
01 VAR4 PIC X(16) VALUE "#0004".
PROCEDURE DIVISION.
MAIN-PROGRAM SECTION.
INIZIO.
IF VAR1 = (VAR2 AND VAR3 AND VAR4)
DISPLAY "TRUE 1"
END-IF
IF VAR1 NOT = (VAR2 AND VAR3 AND VAR4)
DISPLAY "TRUE 2"
END-IF
IF VAR1 NOT > (VAR2 AND VAR3 AND VAR4)
DISPLAY "TRUE 3"
END-IF
GOBACK.
])

AT_CHECK([$COMPILE prog.cob], [0], [], [])

AT_CHECK([./prog], [0], [TRUE 2
TRUE 3
], [])

AT_CLEANUP


AT_SETUP([abbreviated conditions with multiple words operators])
AT_KEYWORDS([IF])

AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. CHECKCOND.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VAR1 PIC X.
88 VAR1-K VALUE 'K'
01 VAR2 PIC X.
88 VAR2-K VALUE 'K'

PROCEDURE DIVISION.
MAIN-PROGRAM SECTION.
BUG.
IF VAR1-K AND NOT = VAR2-K
DISPLAY "INVALID" UPON STDERR.
GOBACK.
])

AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
[prog.cob:8: error: syntax error, unexpected Identifier
])

AT_CLEANUP
3 changes: 2 additions & 1 deletion tests/testsuite.src/syn_definition.at
Original file line number Diff line number Diff line change
Expand Up @@ -319,9 +319,10 @@ prog.cob:30: error: syntax error, unexpected Identifier
prog.cob:36: error: 'NOT-DEFINED' is not defined
prog.cob:42: error: syntax error, unexpected ELSE
prog.cob:42: error: syntax error, unexpected Identifier
prog.cob:42: error: invalid expression
prog.cob:42: error: incomplete expression
prog.cob:47: error: 'broken' is not defined
])

AT_CLEANUP


Expand Down
Loading

0 comments on commit a0d4a56

Please sign in to comment.