From: Feng Wang Date: Tue, 15 Mar 2005 02:52:38 +0000 (+0000) Subject: re PR fortran/18827 (ICE on assign to common variable) X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ce2df7c64ae0185dab22bb38628acf8ae48551b7;p=platform%2Fupstream%2Fgcc.git re PR fortran/18827 (ICE on assign to common variable) fortran/ 2005-03-15 Feng Wang PR fortran/18827 * io.c (resolve_tag): Add checking on assigned label. (match_dt_format): Does not set symbol assign attribute. * match.c (gfc_match_goto):Does not set symbol assign attribute. * resolve.c (resolve_code): Add checking on assigned label. * trans-common.c (build_field): Deals with common variable assigned a label. * trans-stmt.c (gfc_conv_label_variable): New function. (gfc_trans_label_assign): Use it. (gfc_trans_goto): Ditto. * trans-io.c (set_string): Ditto. * trans.h (gfc_conv_label_variable): Add prototype. testsuite/ 2005-03-15 Feng Wang PR fortran/18827 * gfortran.dg/assign_2.f90: New test. * gfortran.dg/assign_3.f90: New test. * gfortran.dg/assign.f90: New test. From-SVN: r96467 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 819442c..415af9d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2005-03-15 Feng Wang + + PR fortran/18827 + * io.c (resolve_tag): Add checking on assigned label. + (match_dt_format): Does not set symbol assign attribute. + * match.c (gfc_match_goto):Does not set symbol assign attribute. + * resolve.c (resolve_code): Add checking on assigned label. + * trans-common.c (build_field): Deals with common variable assigned + a label. + * trans-stmt.c (gfc_conv_label_variable): New function. + (gfc_trans_label_assign): Use it. + (gfc_trans_goto): Ditto. + * trans-io.c (set_string): Ditto. + * trans.h (gfc_conv_label_variable): Add prototype. + 2005-03-14 Tobias Schl"uter PR fortran/20467 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 8230fa9..12650f9 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -981,6 +981,14 @@ resolve_tag (const io_tag * tag, gfc_expr * e) &e->where); return FAILURE; } + /* Check assigned label. */ + if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_INTEGER + && e->symtree->n.sym->attr.assign != 1) + { + gfc_error ("Variable '%s' has not been assigned a format label at %L", + e->symtree->n.sym->name, &e->where); + return FAILURE; + } } else { @@ -1526,9 +1534,6 @@ match_dt_format (gfc_dt * dt) gfc_free_expr (e); goto conflict; } - if (e->ts.type == BT_INTEGER && e->rank == 0) - e->symtree->n.sym->attr.assign = 1; - dt->format_expr = e; return MATCH_YES; } diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 2a36447..f433db5 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1526,7 +1526,6 @@ gfc_match_goto (void) == FAILURE) return MATCH_ERROR; - expr->symtree->n.sym->attr.assign = 1; new_st.op = EXEC_GOTO; new_st.expr = expr; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 35795c3..730f4fb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3695,10 +3695,17 @@ resolve_code (gfc_code * code, gfc_namespace * ns) break; case EXEC_GOTO: - if (code->expr != NULL && code->expr->ts.type != BT_INTEGER) - gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER " + if (code->expr != NULL) + { + if (code->expr->ts.type != BT_INTEGER) + gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER " "variable", &code->expr->where); - else + else if (code->expr->symtree->n.sym->attr.assign != 1) + gfc_error ("Variable '%s' has not been assigned a target label " + "at %L", code->expr->symtree->n.sym->name, + &code->expr->where); + } + else resolve_branch (code->label, code); break; diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index c62d68d..c8db6e7 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -242,6 +242,27 @@ build_field (segment_info *h, tree union_type, record_layout_info rli) size_binop (PLUS_EXPR, DECL_FIELD_OFFSET (field), DECL_SIZE_UNIT (field))); + /* If this field is assigned to a label, we create another two variables. + One will hold the address of taget label or format label. The other will + hold the length of format label string. */ + if (h->sym->attr.assign) + { + tree len; + tree addr; + + gfc_allocate_lang_decl (field); + GFC_DECL_ASSIGN (field) = 1; + len = gfc_create_var_np (gfc_charlen_type_node,h->sym->name); + addr = gfc_create_var_np (pvoid_type_node, h->sym->name); + TREE_STATIC (len) = 1; + TREE_STATIC (addr) = 1; + DECL_INITIAL (len) = build_int_cst (NULL_TREE, -2); + gfc_set_decl_location (len, &h->sym->declared_at); + gfc_set_decl_location (addr, &h->sym->declared_at); + GFC_DECL_STRING_LEN (field) = pushdecl_top_level (len); + GFC_DECL_ASSIGN_ADDR (field) = pushdecl_top_level (addr); + } + h->field = field; } @@ -434,7 +455,7 @@ create_common (gfc_common_head *com, segment_info * head) for (s = head; s; s = next_s) { s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field), - decl, s->field, NULL_TREE); + decl, s->field, NULL_TREE); next_s = s->next; gfc_free (s); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 26f05f1..4169321 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -397,7 +397,6 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, tree len; gfc_init_se (&se, NULL); - gfc_conv_expr (&se, e); io = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE); len = build3 (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len, @@ -406,6 +405,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, /* Integer variable assigned a format label. */ if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) { + gfc_conv_label_variable (&se, e); msg = gfc_build_cstring_const ("Assigned label is not a format label"); tmp = GFC_DECL_STRING_LEN (se.expr); @@ -417,6 +417,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, } else { + gfc_conv_expr (&se, e); gfc_conv_string_parameter (&se); gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr)); gfc_add_modify_expr (&se.pre, len, se.string_length); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index da074c8..ea5da88 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -80,7 +80,23 @@ gfc_trans_label_here (gfc_code * code) return build1_v (LABEL_EXPR, gfc_get_label_decl (code->here)); } + +/* Given a variable expression which has been ASSIGNed to, find the decl + containing the auxiliary variables. For variables in common blocks this + is a field_decl. */ + +void +gfc_conv_label_variable (gfc_se * se, gfc_expr * expr) +{ + gcc_assert (expr->symtree->n.sym->attr.assign == 1); + gfc_conv_expr (se, expr); + /* Deals with variable in common block. Get the field declaration. */ + if (TREE_CODE (se->expr) == COMPONENT_REF) + se->expr = TREE_OPERAND (se->expr, 1); +} + /* Translate a label assignment statement. */ + tree gfc_trans_label_assign (gfc_code * code) { @@ -95,7 +111,8 @@ gfc_trans_label_assign (gfc_code * code) /* Start a new block. */ gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_expr (&se, code->expr); + gfc_conv_label_variable (&se, code->expr); + len = GFC_DECL_STRING_LEN (se.expr); addr = GFC_DECL_ASSIGN_ADDR (se.expr); @@ -103,6 +120,8 @@ gfc_trans_label_assign (gfc_code * code) if (code->label->defined == ST_LABEL_TARGET) { + /* Shouldn't need to set this flag. Reserve for optimization bug. */ + DECL_ARTIFICIAL (label_tree) = 0; label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); len_tree = integer_minus_one_node; } @@ -140,7 +159,7 @@ gfc_trans_goto (gfc_code * code) /* ASSIGNED GOTO. */ gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_expr (&se, code->expr); + gfc_conv_label_variable (&se, code->expr); assign_error = gfc_build_cstring_const ("Assigned label is not a target label"); tmp = GFC_DECL_STRING_LEN (se.expr); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index aad878f..712c530 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -289,6 +289,8 @@ void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr); void gfc_conv_expr_reference (gfc_se * se, gfc_expr *); /* Equivalent to convert(type, gfc_conv_expr_val(se, expr)). */ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); +/* Find the decl containing the auxiliary variables for assigned variables. */ +void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr); /* If the value is not constant, Create a temporary and copy the value. */ tree gfc_evaluate_now (tree, stmtblock_t *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6d39769..765cc43 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2005-03-15 Feng Wang + + PR fortran/18827 + * gfortran.dg/assign_2.f90: New test. + * gfortran.dg/assign_3.f90: New test. + * gfortran.dg/assign.f90: New test. + 2005-03-15 Joseph S. Myers * g++.dg/other/cv_func.C, g++.dg/other/offsetof3.C, diff --git a/gcc/testsuite/gfortran.dg/assign.f90 b/gcc/testsuite/gfortran.dg/assign.f90 new file mode 100644 index 0000000..516a3d7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assign.f90 @@ -0,0 +1,8 @@ +! { dg-do run } +! Program to test ASSIGNing a label to common variable. PR18827. + program test + integer i + common i + assign 2000 to i ! { dg-warning "Obsolete: ASSIGN statement" } +2000 continue + end diff --git a/gcc/testsuite/gfortran.dg/assign_2.f90 b/gcc/testsuite/gfortran.dg/assign_2.f90 new file mode 100644 index 0000000..4119cd9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assign_2.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! Option passed to avoid excess errors from obsolete warning +! { dg-options "-w" } +! PR18827 + integer i,j + common /foo/ i,j + assign 1000 to j + j = 5 + goto j + 1000 continue + end diff --git a/gcc/testsuite/gfortran.dg/assign_3.f90 b/gcc/testsuite/gfortran.dg/assign_3.f90 new file mode 100644 index 0000000..a43b10c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assign_3.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! Option passed to avoid excess errors from obsolete warning +! { dg-options "-w" } +! PR18827 + integer i,j + equivalence (i,j) + assign 1000 to i + write (*, j) ! { dg-error "not been assigned a format label" } + goto j ! { dg-error "not been assigned a target label" } + 1000 continue + end