2006-05-15 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25090
* resolve.c: Static resolving_index_expr initialized.
(entry_parameter): New function to emit errors for variables
that are not entry parameters.
(gfc_resolve_expr): Call entry_parameter, when resolving
variables, if the namespace has entries and resolving_index_expr
is set.
(resolve_charlen): Set resolving_index_expr before the call to
resolve_index_expr and reset it afterwards.
(resolve_fl_variable): The same before and after the call to
is_non_constant_shape_array, which ultimately makes a call to
gfc_resolve_expr.
PR fortran/25082
* resolve.c (resolve_code): Add error condition that the return
expression must be scalar.
PR fortran/24711
* matchexp.c (gfc_get_parentheses): New function.
(match_primary): Remove inline code and call above.
* gfortran.h: Provide prototype for gfc_get_parentheses.
* resolve.c (resolve_array_ref): Call the above, when start is a
derived type variable array reference.
2006-05-15 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25090
* gfortran.dg/entry_dummy_ref_1.f90: New test.
PR fortran/25082
* gfortran.dg/scalar_return_1.f90: New test.
PR fortran/24711
* gfortran.dg/derived_comp_array_ref_1.f90: New test.
From-SVN: r113796
+2006-05-15 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/25090
+ * resolve.c: Static resolving_index_expr initialized.
+ (entry_parameter): New function to emit errors for variables
+ that are not entry parameters.
+ (gfc_resolve_expr): Call entry_parameter, when resolving
+ variables, if the namespace has entries and resolving_index_expr
+ is set.
+ (resolve_charlen): Set resolving_index_expr before the call to
+ resolve_index_expr and reset it afterwards.
+ (resolve_fl_variable): The same before and after the call to
+ is_non_constant_shape_array, which ultimately makes a call to
+ gfc_resolve_expr.
+
+ PR fortran/25082
+ * resolve.c (resolve_code): Add error condition that the return
+ expression must be scalar.
+
+ PR fortran/24711
+ * matchexp.c (gfc_get_parentheses): New function.
+ (match_primary): Remove inline code and call above.
+ * gfortran.h: Provide prototype for gfc_get_parentheses.
+ * resolve.c (resolve_array_ref): Call the above, when start is a
+ derived type variable array reference.
+
2006-05-15 Jakub Jelinek <jakub@redhat.com>
PR fortran/27446
void gfc_free_data (gfc_data *);
void gfc_free_case_list (gfc_case *);
+/* matchexp.c -- FIXME too? */
+gfc_expr *gfc_get_parentheses (gfc_expr *);
+
/* openmp.c */
void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
}
+/* Call the INTRINSIC_PARENTHESES function. This is both
+ used explicitly, as below, or by resolve.c to generate
+ temporaries. */
+gfc_expr *
+gfc_get_parentheses (gfc_expr *e)
+{
+ gfc_expr *e2;
+
+ e2 = gfc_get_expr();
+ e2->expr_type = EXPR_OP;
+ e2->ts = e->ts;
+ e2->rank = e->rank;
+ e2->where = e->where;
+ e2->value.op.operator = INTRINSIC_PARENTHESES;
+ e2->value.op.op1 = e;
+ e2->value.op.op2 = NULL;
+ return e2;
+}
+
+
/* Match a primary expression. */
static match
if(!gfc_numeric_ts(&e->ts))
*result = e;
else
- {
- gfc_expr *e2 = gfc_get_expr();
-
- e2->expr_type = EXPR_OP;
- e2->ts = e->ts;
- e2->rank = e->rank;
- e2->where = where;
- e2->value.op.operator = INTRINSIC_PARENTHESES;
- e2->value.op.op1 = e;
- e2->value.op.op2 = NULL;
- *result = e2;
- }
+ *result = gfc_get_parentheses (e);
if (m != MATCH_YES)
{
resets the flag each time that it is read. */
static int formal_arg_flag = 0;
+/* True if we are resolving a specification expression. */
+static int resolving_index_expr = 0;
+
int
gfc_is_formal_arg (void)
{
resolve_array_ref (gfc_array_ref * ar)
{
int i, check_scalar;
+ gfc_expr *e;
for (i = 0; i < ar->dimen; i++)
{
if (gfc_resolve_index (ar->stride[i], check_scalar) == FAILURE)
return FAILURE;
+ e = ar->start[i];
+
if (ar->dimen_type[i] == DIMEN_UNKNOWN)
- switch (ar->start[i]->rank)
+ switch (e->rank)
{
case 0:
ar->dimen_type[i] = DIMEN_ELEMENT;
case 1:
ar->dimen_type[i] = DIMEN_VECTOR;
+ if (e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->ts.type == BT_DERIVED)
+ ar->start[i] = gfc_get_parentheses (e);
break;
default:
gfc_error ("Array index at %L is an array of rank %d",
- &ar->c_where[i], ar->start[i]->rank);
+ &ar->c_where[i], e->rank);
return FAILURE;
}
}
}
+/* Emits an error if the expression is a variable that is not a parameter
+ in all entry formal argument lists for the namespace. */
+
+static void
+entry_parameter (gfc_expr *e)
+{
+ gfc_symbol *sym, *esym;
+ gfc_entry_list *entry;
+ gfc_formal_arglist *f;
+ bool p;
+
+
+ sym = e->symtree->n.sym;
+
+ if (sym->attr.use_assoc
+ || !sym->attr.dummy
+ || sym->ns != gfc_current_ns)
+ return;
+
+ entry = sym->ns->entries;
+ for (; entry; entry = entry->next)
+ {
+ esym = entry->sym;
+ p = false;
+ for (f = esym->formal; f && !p; f = f->next)
+ {
+ if (f->sym && f->sym->name && sym->name == f->sym->name)
+ p = true;
+ }
+ if (!p)
+ gfc_error ("%s at %L must be a parameter of the entry at %L",
+ sym->name, &e->where, &esym->declared_at);
+ }
+ return;
+}
+
+
/* Resolve an expression. That is, make sure that types of operands agree
with their operators, intrinsic operators are converted to function calls
for overloaded types and unresolved function references are resolved. */
case EXPR_VARIABLE:
t = resolve_variable (e);
+
+ if (gfc_current_ns->entries && resolving_index_expr)
+ entry_parameter (e);
+
if (t == SUCCESS)
expression_rank (e);
break;
break;
case EXEC_RETURN:
- if (code->expr != NULL && code->expr->ts.type != BT_INTEGER)
- gfc_error ("Alternate RETURN statement at %L requires an INTEGER "
- "return specifier", &code->expr->where);
+ if (code->expr != NULL
+ && (code->expr->ts.type != BT_INTEGER || code->expr->rank))
+ gfc_error ("Alternate RETURN statement at %L requires a SCALAR-"
+ "INTEGER return specifier", &code->expr->where);
break;
case EXEC_ASSIGN:
static try
resolve_index_expr (gfc_expr * e)
{
-
if (gfc_resolve_expr (e) == FAILURE)
return FAILURE;
cl->resolved = 1;
+ resolving_index_expr = 1;
+
if (resolve_index_expr (cl->length) == FAILURE)
return FAILURE;
+ resolving_index_expr = 0;
return SUCCESS;
}
if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
return FAILURE;
- /* The shape of a main program or module array needs to be constant. */
- if (sym->ns->proc_name
- && (sym->ns->proc_name->attr.flavor == FL_MODULE
- || sym->ns->proc_name->attr.is_main_program)
- && !sym->attr.use_assoc
+ /* Set this flag to check that variables are parameters of all entries.
+ This check is effected by the call to gfc_resolve_expr through
+ is_non_contant_shape_array. */
+ resolving_index_expr = 1;
+
+ if (!sym->attr.use_assoc
&& !sym->attr.allocatable
&& !sym->attr.pointer
&& is_non_constant_shape_array (sym))
{
- gfc_error ("The module or main program array '%s' at %L must "
- "have constant shape", sym->name, &sym->declared_at);
- return FAILURE;
+ /* The shape of a main program or module array needs to be constant. */
+ if (sym->ns->proc_name
+ && (sym->ns->proc_name->attr.flavor == FL_MODULE
+ || sym->ns->proc_name->attr.is_main_program))
+ {
+ gfc_error ("The module or main program array '%s' at %L must "
+ "have constant shape", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
}
+ resolving_index_expr = 0;
+
if (sym->ts.type == BT_CHARACTER)
{
/* Make sure that character string variables with assumed length are
+2006-05-15 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/25090
+ * gfortran.dg/entry_dummy_ref_1.f90: New test.
+
+ PR fortran/25082
+ * gfortran.dg/scalar_return_1.f90: New test.
+
+ PR fortran/24711
+ * gfortran.dg/derived_comp_array_ref_1.f90: New test.
+
2006-05-15 Jakub Jelinek <jakub@redhat.com>
* gcc.dg/gomp/critical-4.c: New test.
--- /dev/null
+! { dg-do run }
+! Tests the fix for PR27411, in which the array reference on line
+! 18 caused an ICE because the derived type, rather than its integer
+! component, was appearing in the index expression.
+!
+! Contributed by Richard Maine <1fhcwee02@sneakemail.com>
+!
+module gd_calc
+ type calc_signal_type
+ integer :: dummy
+ logical :: used
+ integer :: signal_number
+ end type
+contains
+ subroutine activate_gd_calcs (used, outputs)
+ logical, intent(inout) :: used(:)
+ type(calc_signal_type), pointer :: outputs(:)
+ outputs%used = used(outputs%signal_number)
+ return
+ end subroutine activate_gd_calcs
+end module gd_calc
+
+ use gd_calc
+ integer, parameter :: ndim = 4
+ integer :: i
+ logical :: used_(ndim)
+ type(calc_signal_type), pointer :: outputs_(:)
+ allocate (outputs_(ndim))
+ forall (i = 1:ndim) outputs_(i)%signal_number = ndim + 1 - i
+ used_ = (/.true., .false., .true., .true./)
+ call activate_gd_calcs (used_, outputs_)
+ if (any (outputs_(ndim:1:-1)%used .neqv. used_)) call abort ()
+end
+
+! { dg-final { cleanup-modules "gd_calc" } }
--- /dev/null
+! { dg-do compile }
+! Tests fix for PR25090 in which references in specification
+! expressions to variables that were not entry formal arguments
+! would be missed.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+ SUBROUTINE S1(I) ! { dg-error "must be a parameter of the entry" }
+ CHARACTER(LEN=I+J) :: a ! { dg-error "must be a parameter of the entry" }
+ real :: x(i:j) ! { dg-error "must be a parameter of the entry" }
+ ENTRY E1(J) ! { dg-error "must be a parameter of the entry" }
+ END SUBROUTINE S1
+ END
--- /dev/null
+! { dg-do compile }
+! tests the fix for pr25082 in which the return of an array by a
+! subroutine went undremarked.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+SUBROUTINE S1(*)
+INTEGER :: a(2)
+RETURN a ! { dg-error " requires a SCALAR" }
+END SUBROUTINE S1
projects / platform / upstream / gcc.git / commitdiff