[Fortran] PR fortran/25270: Type mismatch in array index calculation

[Roger Sayle <roger at eyesopen dot com>]

The following patch resolves the type mismatch in gfortran.dg/array-1.f90
(and others) detected by Andrew Pinski's strict type checking assertions.
The problem is that several places in trans-array.c were using the generic
trees integer_zero_node and integer_one_node without casting them to the
appropriate type for array index calculations.  Conveniently, the gfortran
front-end provides gfc_index_zero_node and gfc_index_one_node of the
correct type, gfc_array_index_type, for precisely this purpose.  I audited
all uses of integer_{zero,one}_node in trans-array.c and the following
patch fixes all the problematic instances.

Unfortunately, significant type safety issues in the middle-end's scalar
evolution code means that I've been unable to confirm whether this
resolves all of PR fortran/25270, i.e. whether the gfortran testsuite is
now clean, however this patch should resolve a significant fraction of
the mismatches.


The following patch has been tested on x86_64-unknown-linux-gnu with a
full "make bootstrap", all default languages, and regression tested with
a top-level "make -k check" with no new failures.

Ok for mainline?



2006-03-27  Roger Sayle  <roger@eyesopen.com>

	PR fortran/25270
	* trans-array.c (gfc_trans_allocate_array_storage): In array index
	calculations use gfc_index_zero_node and gfc_index_one_node instead
	of integer_zero_node and integer_one_node respectively.
	(gfc_conv_array_transpose): Likewise.
	(gfc_conv_ss_startstride): Likewise.
	(gfc_trans_dummy_array_bias): Likewise.


Index: trans-array.c
===================================================================
*** trans-array.c	(revision 112052)
--- trans-array.c	(working copy)
*************** gfc_trans_allocate_array_storage (stmtbl
*** 514,520 ****
  	{
  	  /* Make a temporary variable to hold the data.  */
  	  tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (nelem), nelem,
! 			     integer_one_node);
  	  tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
  				  tmp);
  	  tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
--- 514,520 ----
  	{
  	  /* Make a temporary variable to hold the data.  */
  	  tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (nelem), nelem,
! 			     gfc_index_one_node);
  	  tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
  				  tmp);
  	  tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
*************** gfc_conv_array_transpose (gfc_se * se, g
*** 726,734 ****
    gcc_assert (src_info->dimen == 2);
    for (n = 0; n < 2; n++)
      {
!       dest_info->delta[n] = integer_zero_node;
!       dest_info->start[n] = integer_zero_node;
!       dest_info->stride[n] = integer_one_node;
        dest_info->dim[n] = n;

        dest_index = gfc_rank_cst[n];
--- 726,734 ----
    gcc_assert (src_info->dimen == 2);
    for (n = 0; n < 2; n++)
      {
!       dest_info->delta[n] = gfc_index_zero_node;
!       dest_info->start[n] = gfc_index_zero_node;
!       dest_info->stride[n] = gfc_index_one_node;
        dest_info->dim[n] = n;

        dest_index = gfc_rank_cst[n];
*************** gfc_conv_ss_startstride (gfc_loopinfo *
*** 2445,2451 ****

        gfc_start_block (&block);

!       fault = integer_zero_node;
        for (n = 0; n < loop->dimen; n++)
  	size[n] = NULL_TREE;

--- 2445,2451 ----

        gfc_start_block (&block);

!       fault = boolean_false_node;
        for (n = 0; n < loop->dimen; n++)
  	size[n] = NULL_TREE;

*************** gfc_trans_dummy_array_bias (gfc_symbol *
*** 3545,3551 ****
        partial = gfc_create_var (boolean_type_node, "partial");
        TREE_USED (partial) = 1;
        tmp = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]);
!       tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, integer_one_node);
        gfc_add_modify_expr (&block, partial, tmp);
      }
    else
--- 3545,3551 ----
        partial = gfc_create_var (boolean_type_node, "partial");
        TREE_USED (partial) = 1;
        tmp = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]);
!       tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, gfc_index_one_node);
        gfc_add_modify_expr (&block, partial, tmp);
      }
    else
*************** gfc_trans_dummy_array_bias (gfc_symbol *
*** 3561,3567 ****
        stride = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]);
        stride = gfc_evaluate_now (stride, &block);

!       tmp = build2 (EQ_EXPR, boolean_type_node, stride, integer_zero_node);
        tmp = build3 (COND_EXPR, gfc_array_index_type, tmp,
  		    gfc_index_one_node, stride);
        stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
--- 3561,3567 ----
        stride = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]);
        stride = gfc_evaluate_now (stride, &block);

!       tmp = build2 (EQ_EXPR, boolean_type_node, stride, gfc_index_zero_node);
        tmp = build3 (COND_EXPR, gfc_array_index_type, tmp,
  		    gfc_index_one_node, stride);
        stride = GFC_TYPE_ARRAY_STRIDE (type, 0);


Roger
--