This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran] Fix PR 16907: Allow REAL array indices


This is an extension g77 had and we were missing.
I deliberately chose the following error not to say anything about the extension:
  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;
    }
   ...
I thought it would be the easiest way to avoid special cases, and there's no
point in advertising an extension.

Bubblestrapped and regtested, new testcase attached.  Ok?

- Tobi
2005-03-13  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/16907
	* resolve.c (gfc_resolve_index): Allow REAL indices as an extension.

Index: resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.35
diff -c -3 -p -r1.35 resolve.c
*** resolve.c	5 Mar 2005 22:13:21 -0000	1.35
--- resolve.c	13 Mar 2005 17:56:37 -0000
*************** gfc_resolve_index (gfc_expr * index, int
*** 1701,1724 ****
    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)
      {
!       ts.type = BT_INTEGER;
!       ts.kind = gfc_index_integer_kind;
  
!       gfc_convert_type_warn (index, &ts, 2, 0);
      }
  
    return SUCCESS;
--- 1701,1733 ----
    if (gfc_resolve_expr (index) == FAILURE)
      return FAILURE;
  
!   if (check_scalar && index->rank != 0)
      {
!       gfc_error ("Array index at %L must be scalar", &index->where);
        return FAILURE;
      }
  
!   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;
      }
!   else
      {
!       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_REAL)
! 	{
! 	  ts.type = BT_INTEGER;
! 	  ts.kind = gfc_index_integer_kind;
! 
! 	  gfc_convert_type_warn (index, &ts, 2, 0);
! 	}
      }
  
    return SUCCESS;

! { 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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]