[gfortran,patch] Fix Fortran/18827
Feng Wang
wf_cs@yahoo.com
Wed Jan 12 05:26:00 GMT 2005
and the original message:
http://gcc.gnu.org/ml/fortran/2004-12/msg00136.html
--- Feng Wang <wf_cs@yahoo.com> µÄÕýÎÄ£º
> Ping!
>
> Today I tested again on i686 with no regression and regenerated a new patch
> attached here.
>
> --- Feng Wang <wf_cs@yahoo.com> µÄÕýÎÄ£º
> > Hi, Paul
> > I tested on i686-linux today and found no regression. The sources patched
> > is
> > the snapshot downloaded from gfortran.org on 20th, Dec.
> > Did you patch entirely?
> >
> > Feng Wang
> >
> > --- Paul Brook <paul@codesourcery.com> µÄÕýÎÄ£º
> > > Not ok. This causes many regressions on i686-linux. For example:
> > >
> > > FAIL: gfortran.dg/g77/20010519-1.f -O (test for excess errors)
> > > Excess errors:
> > > /home/paul/cases/gcc/gcc/testsuite/gfortran.dg/g77/20010519-1.f:711:
> > internal
> > >
> > > compiler error: in gfc_conv_label_variable, at fortran/trans-stmt.c:89
> > >
> > > Lines 87-79 are as follows:
> > >
> > > gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
> > > {
> > > gcc_assert (expr->symtree->n.sym->attr.assign != 1);
> > >
> > > Paul
> > >
> >
>
> _________________________________________________________
> Do You Yahoo!?
> 150ÃòÇúMP3·è¿ñËÑ£¬´øÄú´³ÈëÒôÀÖµîÌÃ
> http://music.yisou.com/
> ÃÀÅ®Ã÷ÃÇÓ¦Óþ¡Óã¬ËѱéÃÀü¡¢ÑÞüºÃ¿áü
> http://image.yisou.com
> 1G¾ÃÊÇ1000Õ×£¬ÑÅ»¢µçÓÊ×ÔÖúÀ©Èã¡
>
http://cn.rd.yahoo.com/mail_cn/tag/1g/*http://cn.mail.yahoo.com/event/mail_1g/>
Common subdirectories: gcc-4.0.0-20050111/gcc/fortran/CVS and ./CVS
> diff -c3p gcc-4.0.0-20050111/gcc/fortran/io.c ./io.c
> *** gcc-4.0.0-20050111/gcc/fortran/io.c 2005-01-04 05:43:50.000000000 +0800
> --- ./io.c 2005-01-12 08:59:39.000000000 +0800
> *************** resolve_tag (const io_tag * tag, gfc_exp
> *** 981,986 ****
> --- 981,994 ----
> &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
> {
> *************** match_dt_format (gfc_dt * dt)
> *** 1526,1534 ****
> 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;
> }
> --- 1534,1539 ----
> diff -c3p gcc-4.0.0-20050111/gcc/fortran/match.c ./match.c
> *** gcc-4.0.0-20050111/gcc/fortran/match.c 2005-01-04 05:43:50.000000000
> +0800
> --- ./match.c 2005-01-12 08:59:39.000000000 +0800
> *************** gfc_match_goto (void)
> *** 1525,1531 ****
> == FAILURE)
> return MATCH_ERROR;
>
> - expr->symtree->n.sym->attr.assign = 1;
> new_st.op = EXEC_GOTO;
> new_st.expr = expr;
>
> --- 1525,1530 ----
> diff -c3p gcc-4.0.0-20050111/gcc/fortran/resolve.c ./resolve.c
> *** gcc-4.0.0-20050111/gcc/fortran/resolve.c 2005-01-04 05:43:50.000000000
> +0800
> --- ./resolve.c 2005-01-12 08:59:39.000000000 +0800
> *************** resolve_code (gfc_code * code, gfc_names
> *** 3659,3668 ****
> break;
>
> case EXEC_GOTO:
> ! if (code->expr != NULL && code->expr->ts.type != BT_INTEGER)
> ! gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER "
> "variable", &code->expr->where);
> ! else
> resolve_branch (code->label, code);
> break;
>
> --- 3659,3675 ----
> break;
>
> case EXEC_GOTO:
> ! 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 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 -c3p gcc-4.0.0-20050111/gcc/fortran/trans-common.c ./trans-common.c
> *** gcc-4.0.0-20050111/gcc/fortran/trans-common.c 2005-01-10
> 06:57:40.000000000 +0800
> --- ./trans-common.c 2005-01-12 08:59:39.000000000 +0800
> *************** build_field (segment_info *h, tree union
> *** 242,247 ****
> --- 242,270 ----
> size_binop (PLUS_EXPR,
> DECL_FIELD_OFFSET (field),
> DECL_SIZE_UNIT (field)));
> + /* If this field is assigned to a lable, we create another two variables
> + to hold the address of taget label or the format string of format
> + label. */
> + 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);
> + TREE_PUBLIC (len) = 1;
> + TREE_PUBLIC (addr) = 1;
> + 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;
> }
>
> *************** create_common (gfc_common_head *com, seg
> *** 429,435 ****
> for (s = head; s; s = next_s)
> {
> s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field),
> ! decl, s->field, NULL_TREE);
>
> next_s = s->next;
> gfc_free (s);
> --- 452,458 ----
> for (s = head; s; s = next_s)
> {
> s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field),
> ! decl, s->field, NULL_TREE);
>
> next_s = s->next;
> gfc_free (s);
> diff -c3p gcc-4.0.0-20050111/gcc/fortran/trans.h ./trans.h
> *** gcc-4.0.0-20050111/gcc/fortran/trans.h 2004-11-16 10:02:37.000000000
> +0800
> --- ./trans.h 2005-01-12 08:59:39.000000000 +0800
> *************** void gfc_conv_expr_lhs (gfc_se * se, gfc
> *** 289,294 ****
> --- 289,296 ----
> 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);
> + /* Converts a variable assigned a label. */
> + 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 -c3p gcc-4.0.0-20050111/gcc/fortran/trans-io.c ./trans-io.c
> *** gcc-4.0.0-20050111/gcc/fortran/trans-io.c 2005-01-04 05:43:55.000000000
> +0800
> --- ./trans-io.c 2005-01-12 08:59:39.000000000 +0800
> *************** set_string (stmtblock_t * block, stmtblo
> *** 397,403 ****
> 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,
> --- 397,402 ----
> *************** set_string (stmtblock_t * block, stmtblo
> *** 406,411 ****
> --- 405,411 ----
> /* 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);
> *************** set_string (stmtblock_t * block, stmtblo
> *** 417,422 ****
> --- 417,423 ----
> }
> 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 -c3p gcc-4.0.0-20050111/gcc/fortran/trans-stmt.c ./trans-stmt.c
> *** gcc-4.0.0-20050111/gcc/fortran/trans-stmt.c 2005-01-04 05:43:55.000000000
> +0800
> --- ./trans-stmt.c 2005-01-12 08:59:39.000000000 +0800
> *************** gfc_trans_label_here (gfc_code * code)
> *** 80,85 ****
> --- 80,96 ----
> return build1_v (LABEL_EXPR, gfc_get_label_decl (code->here));
> }
>
> + /* Converts a varible assigned a label. */
> + 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)
> *************** gfc_trans_label_assign (gfc_code * code)
> *** 95,101 ****
> /* Start a new block. */
> gfc_init_se (&se, NULL);
> gfc_start_block (&se.pre);
> ! gfc_conv_expr (&se, code->expr);
> len = GFC_DECL_STRING_LEN (se.expr);
> addr = GFC_DECL_ASSIGN_ADDR (se.expr);
>
> --- 106,113 ----
> /* Start a new block. */
> gfc_init_se (&se, NULL);
> gfc_start_block (&se.pre);
> ! gfc_conv_label_variable (&se, code->expr);
> !
> len = GFC_DECL_STRING_LEN (se.expr);
> addr = GFC_DECL_ASSIGN_ADDR (se.expr);
>
> *************** gfc_trans_goto (gfc_code * code)
> *** 140,146 ****
> /* ASSIGNED GOTO. */
> gfc_init_se (&se, NULL);
> gfc_start_block (&se.pre);
> ! gfc_conv_expr (&se, code->expr);
> assign_error =
> gfc_build_cstring_const ("Assigned label is not a target label");
> tmp = GFC_DECL_STRING_LEN (se.expr);
> --- 152,158 ----
> /* ASSIGNED GOTO. */
> gfc_init_se (&se, NULL);
> gfc_start_block (&se.pre);
> ! 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);
>
_________________________________________________________
Do You Yahoo!?
150ÃòÇúMP3·è¿ñËÑ£¬´øÄú´³ÈëÒôÀÖµîÌÃ
http://music.yisou.com/
ÃÀÅ®Ã÷ÃÇÓ¦Óþ¡Óã¬ËѱéÃÀü¡¢ÑÞüºÃ¿áü
http://image.yisou.com
1G¾ÃÊÇ1000Õ×£¬ÑÅ»¢µçÓÊ×ÔÖúÀ©Èã¡
http://cn.rd.yahoo.com/mail_cn/tag/1g/*http://cn.mail.yahoo.com/event/mail_1g/
More information about the Gcc-patches
mailing list