This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran,patch] Fix Fortran/18827
- From: Feng Wang <wf_cs at yahoo dot com>
- To: Feng Wang <wf_cs at yahoo dot com>, Paul Brook <paul at codesourcery dot com>, fortran at gcc dot gnu dot org
- Cc: Feng Wang <wf_cs at yahoo dot com>, gcc-patches at gcc dot gnu dot org
- Date: Wed, 12 Jan 2005 11:58:38 +0800 (CST)
- Subject: Re: [gfortran,patch] Fix Fortran/18827
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);