diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d4823b3e153..f116966ebdc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2005-03-13 Tobias Schl"uter + + PR fortran/16907 + * resolve.c (gfc_resolve_index): Allow REAL indices as an extension. + 2005-03-13 Tobias Schl"uter PR fortran/20323 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b51206f91b7..35795c3ff2a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1701,19 +1701,26 @@ gfc_resolve_index (gfc_expr * index, int check_scalar) if (gfc_resolve_expr (index) == FAILURE) return FAILURE; - if (index->ts.type != BT_INTEGER) - { - gfc_error ("Array index at %L must be of INTEGER type", &index->where); - return FAILURE; - } - if (check_scalar && index->rank != 0) { gfc_error ("Array index at %L must be scalar", &index->where); return FAILURE; } - if (index->ts.kind != gfc_index_integer_kind) + if (index->ts.type != BT_INTEGER && index->ts.type != BT_REAL) + { + gfc_error ("Array index at %L must be of INTEGER type", + &index->where); + return FAILURE; + } + + if (index->ts.type == BT_REAL) + if (gfc_notify_std (GFC_STD_GNU, "Extension: REAL array index at %L", + &index->where) == FAILURE) + return FAILURE; + + if (index->ts.kind != gfc_index_integer_kind + || index->ts.type != BT_INTEGER) { ts.type = BT_INTEGER; ts.kind = gfc_index_integer_kind; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d3b3eb591cc..bcc841588f6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2003-03-13 Tobias Schl"uter + + PR fortran/16907 + * gfortran.dg/real_index_1.f90: New test. + 2005-03-13 Tobias Schl"uter PR fortran/20323 diff --git a/gcc/testsuite/gfortran.dg/real_index_1.f90 b/gcc/testsuite/gfortran.dg/real_index_1.f90 new file mode 100644 index 00000000000..16ceca82774 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/real_index_1.f90 @@ -0,0 +1,7 @@ +! { dg-do run } +! PR 16907 : We didn't support REAL array indices as an extension + integer I, A(10) + A = 2 + I=A(1.0) ! { dg-warning "Extension" } + if (i/=2) call abort () + end