summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog47
-rw-r--r--gcc/fortran/check.c4
-rw-r--r--gcc/fortran/decl.c1
-rw-r--r--gcc/fortran/frontend-passes.c71
-rw-r--r--gcc/fortran/interface.c1
-rw-r--r--gcc/fortran/module.c2
-rw-r--r--gcc/fortran/parse.c6
-rw-r--r--gcc/fortran/resolve.c10
-rw-r--r--gcc/fortran/trans-array.c3
-rw-r--r--gcc/fortran/trans-expr.c4
10 files changed, 105 insertions, 44 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dbfaa7cd5dd..08c666ac4a6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,50 @@
+2011-06-18 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/49400
+ * decl.c (gfc_match_procedure): Allow PROCEDURE declarations inside
+ BLOCK constructs.
+
+2011-06-17 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/48699
+ * check.c (gfc_check_move_alloc): If 'TO' argument is polymorphic,
+ make sure the vtab is present.
+
+2011-06-16 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/49074
+ * interface.c (gfc_extend_assign): Propagate the locus from the
+ assignment to the type-bound procedure call.
+
+2011-06-16 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/49417
+ * module.c (mio_component): Make sure the 'class_ok' attribute is set
+ for use-associated CLASS components.
+ * parse.c (parse_derived): Check for 'class_ok' attribute.
+ * resolve.c (resolve_fl_derived): Ditto.
+
+2011-06-13 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ * frontend-passes.c (remove_trim): New function.
+ (optimize_assignment): Use it.
+ (optimize_comparison): Likewise. Return correct status
+ for previous change.
+
+2011-06-12 Tobias Burnus
+
+ PR fortran/49324
+ * trans-expr.c (gfc_trans_assignment_1): Tell
+ gfc_trans_scalar_assign to also deep-copy RHS nonvariables
+ with allocatable components.
+ * trans-array.c (gfc_conv_expr_descriptor): Ditto.
+
+2011-05-11 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ * frontend-passes.c (optimize_assignment): Follow chains
+ of concatenation operators to the end for removing trailing
+ TRIMS for assignments.
+
2011-06-10 Daniel Carrera <dcarrera@gmail.com>
* trans-decl.c (gfc_build_builtin_function_decls):
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 11789673115..972b290c987 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2672,6 +2672,10 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
return FAILURE;
}
+ /* CLASS arguments: Make sure the vtab is present. */
+ if (to->ts.type == BT_CLASS)
+ gfc_find_derived_vtab (from->ts.u.derived);
+
return SUCCESS;
}
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7098368e56e..661bb14486f 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4970,6 +4970,7 @@ gfc_match_procedure (void)
case COMP_MODULE:
case COMP_SUBROUTINE:
case COMP_FUNCTION:
+ case COMP_BLOCK:
m = match_procedure_decl ();
break;
case COMP_INTERFACE:
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index f100e1fb811..4d8c77a1269 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -486,6 +486,35 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op)
return false;
}
+/* Remove unneeded TRIMs at the end of expressions. */
+
+static bool
+remove_trim (gfc_expr *rhs)
+{
+ bool ret;
+
+ ret = false;
+
+ /* Check for a // b // trim(c). Looping is probably not
+ necessary because the parser usually generates
+ (// (// a b ) trim(c) ) , but better safe than sorry. */
+
+ while (rhs->expr_type == EXPR_OP
+ && rhs->value.op.op == INTRINSIC_CONCAT)
+ rhs = rhs->value.op.op2;
+
+ while (rhs->expr_type == EXPR_FUNCTION && rhs->value.function.isym
+ && rhs->value.function.isym->id == GFC_ISYM_TRIM)
+ {
+ strip_function_call (rhs);
+ /* Recursive call to catch silly stuff like trim ( a // trim(b)). */
+ remove_trim (rhs);
+ ret = true;
+ }
+
+ return ret;
+}
+
/* Optimizations for an assignment. */
static void
@@ -499,16 +528,7 @@ optimize_assignment (gfc_code * c)
/* Optimize away a = trim(b), where a is a character variable. */
if (lhs->ts.type == BT_CHARACTER)
- {
- if (rhs->expr_type == EXPR_FUNCTION &&
- rhs->value.function.isym &&
- rhs->value.function.isym->id == GFC_ISYM_TRIM)
- {
- strip_function_call (rhs);
- optimize_assignment (c);
- return;
- }
- }
+ remove_trim (rhs);
if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
optimize_binop_array_assignment (c, &rhs, false);
@@ -631,36 +651,17 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
/* Strip off unneeded TRIM calls from string comparisons. */
- change = false;
+ change = remove_trim (op1);
- if (op1->expr_type == EXPR_FUNCTION
- && op1->value.function.isym
- && op1->value.function.isym->id == GFC_ISYM_TRIM)
- {
- strip_function_call (op1);
- change = true;
- }
-
- if (op2->expr_type == EXPR_FUNCTION
- && op2->value.function.isym
- && op2->value.function.isym->id == GFC_ISYM_TRIM)
- {
- strip_function_call (op2);
- change = true;
- }
-
- if (change)
- {
- optimize_comparison (e, op);
- return true;
- }
+ if (remove_trim (op2))
+ change = true;
/* An expression of type EXPR_CONSTANT is only valid for scalars. */
/* TODO: A scalar constant may be acceptable in some cases (the scalarizer
handles them well). However, there are also cases that need a non-scalar
argument. For example the any intrinsic. See PR 45380. */
if (e->rank > 0)
- return false;
+ return change;
/* Don't compare REAL or COMPLEX expressions when honoring NaNs. */
@@ -690,7 +691,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
&& op2_left->expr_type == EXPR_CONSTANT
&& op1_left->value.character.length
!= op2_left->value.character.length)
- return false;
+ return change;
else
{
free (op1_left);
@@ -779,7 +780,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
}
}
- return false;
+ return change;
}
/* Optimize a trim function by replacing it with an equivalent substring
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 46f9d146ce7..e787187ba80 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3242,6 +3242,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
c->expr1 = gfc_get_expr ();
build_compcall_for_operator (c->expr1, actual, tb_base, tbo, gname);
c->expr1->value.compcall.assign = 1;
+ c->expr1->where = c->loc;
c->expr2 = NULL;
c->op = EXEC_COMPCALL;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 533246d0c8d..89281a5c17c 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2403,6 +2403,8 @@ mio_component (gfc_component *c, int vtype)
mio_array_spec (&c->as);
mio_symbol_attribute (&c->attr);
+ if (c->ts.type == BT_CLASS)
+ c->attr.class_ok = 1;
c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types);
if (!vtype)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6013931d355..5ce5c1e042a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2120,13 +2120,15 @@ endType:
{
/* Look for allocatable components. */
if (c->attr.allocatable
- || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.allocatable)
|| (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
sym->attr.alloc_comp = 1;
/* Look for pointer components. */
if (c->attr.pointer
- || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer)
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.class_pointer)
|| (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
sym->attr.pointer_comp = 1;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b2c31892eb4..cec45cab44d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11789,7 +11789,8 @@ resolve_fl_derived (gfc_symbol *sym)
return FAILURE;
}
- if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer
+ if (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.class_pointer
&& CLASS_DATA (c)->ts.u.derived->components == NULL
&& !CLASS_DATA (c)->ts.u.derived->attr.zero_comp)
{
@@ -11800,9 +11801,10 @@ resolve_fl_derived (gfc_symbol *sym)
}
/* C437. */
- if (c->ts.type == BT_CLASS
- && !(CLASS_DATA (c)->attr.class_pointer
- || CLASS_DATA (c)->attr.allocatable))
+ if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
+ && (!c->attr.class_ok
+ || !(CLASS_DATA (c)->attr.class_pointer
+ || CLASS_DATA (c)->attr.allocatable)))
{
gfc_error ("Component '%s' with CLASS at %L must be allocatable "
"or pointer", c->name, &c->loc);
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c7aeadb3c8b..baf9060fe6b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5808,7 +5808,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
lse.string_length = rse.string_length;
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
- expr->expr_type == EXPR_VARIABLE, true);
+ expr->expr_type == EXPR_VARIABLE
+ || expr->expr_type == EXPR_ARRAY, true);
gfc_add_expr_to_block (&block, tmp);
/* Finish the copying loops. */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index da4af1ae28d..73832657838 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6155,8 +6155,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
l_is_temp || init_flag,
- expr_is_variable (expr2) || scalar_to_array,
- dealloc);
+ expr_is_variable (expr2) || scalar_to_array
+ || expr2->expr_type == EXPR_ARRAY, dealloc);
gfc_add_expr_to_block (&body, tmp);
if (lss == gfc_ss_terminator)
View Lorry Controller Status