gcc/fortran/array.c

8 the terms of the GNU General Public License as published by the Free
154 gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
163   ar->as = as;
284 gfc_free_array_spec (gfc_array_spec *as)
288   if (as == NULL)
291   for (i = 0; i < as->rank + as->corank; i++)
293       gfc_free_expr (as->lower[i]);
294       gfc_free_expr (as->upper[i]);
297   free (as);
333 gfc_resolve_array_spec (gfc_array_spec *as, int check_constant)
338   if (as == NULL)
341   for (i = 0; i < as->rank + as->corank; i++)
343       e = as->lower[i];
347       e = as->upper[i];
351       if ((as->lower[i] == NULL) || (as->upper[i] == NULL))
355       if (as->lower[i]->expr_type == EXPR_CONSTANT
356 	    && as->upper[i]->expr_type == EXPR_CONSTANT
357 	    && mpz_cmp (as->upper[i]->value.integer,
358 			as->lower[i]->value.integer) < 0)
360 	  gfc_free_expr (as->upper[i]);
361 	  as->upper[i] = gfc_copy_expr (as->lower[i]);
362 	  mpz_sub_ui (as->upper[i]->value.integer,
363 		      as->upper[i]->value.integer, 1);
371 /* Match a single array element specification.  The return values as
372    well as the upper and lower bounds of the array spec are filled
374    individual specifications make sense as a whole.
392 match_array_element_spec (gfc_array_spec *as)
398   rank = as->rank == -1 ? 0 : as->rank;
399   lower = &as->lower[rank + as->corank - 1];
400   upper = &as->upper[rank + as->corank - 1];
465   gfc_array_spec *as;
468   as = gfc_get_array_spec ();
482       as->type = AS_ASSUMED_RANK;
483       as->rank = -1;
495       as->rank++;
496       current_type = match_array_element_spec (as);
504       if (as->rank == 1)
508 	  as->type = current_type;
511 	switch (as->type)
528 		as->type = AS_ASSUMED_SIZE;
555 		as->type = AS_ASSUMED_SHAPE;
563 	    if (as->rank == 2 && current_type == AS_ASSUMED_SIZE)
565 		as->type = AS_IMPLIED_SHAPE;
585       if (as->rank + as->corank >= GFC_MAX_DIMENSIONS)
592       if (as->corank + as->rank >= 7
614   if (as->rank >= GFC_MAX_DIMENSIONS)
623       as->corank++;
624       current_type = match_array_element_spec (as);
629       if (as->corank == 1)
630 	as->cotype = current_type;
632 	switch (as->cotype)
641 		  as->cotype = AS_ASSUMED_SIZE;
668 		  as->cotype = AS_ASSUMED_SHAPE;
692       if (as->rank + as->corank >= GFC_MAX_DIMENSIONS)
706   if (as->cotype == AS_ASSUMED_SIZE)
707     as->cotype = AS_EXPLICIT;
709   if (as->rank == 0)
710     as->type = as->cotype;
713   if (as->rank == 0 && as->corank == 0)
716       gfc_free_array_spec (as);
721   if (as->type == AS_ASSUMED_SHAPE)
723       for (i = 0; i < as->rank + as->corank; i++)
725 	  if (as->lower[i] == NULL)
726 	    as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
730   *asp = as;
736   gfc_free_array_spec (as);
746 gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
750   if (as == NULL)
753   if (as->rank
757   if (as->corank
761   if (sym->as == NULL)
763       sym->as = as;
767   if ((sym->as->type == AS_ASSUMED_RANK && as->corank)
768       || (as->type == AS_ASSUMED_RANK && sym->as->corank))
775   if (as->corank)
779       gcc_assert (as->rank == 0 && sym->as->corank == 0);
781       sym->as->cotype = as->cotype;
782       sym->as->corank = as->corank;
783       for (i = 0; i < as->corank; i++)
785 	  sym->as->lower[sym->as->rank + i] = as->lower[i];
786 	  sym->as->upper[sym->as->rank + i] = as->upper[i];
794       gcc_assert (as->corank == 0 && sym->as->rank == 0);
796       sym->as->rank = as->rank;
797       sym->as->type = as->type;
798       sym->as->cray_pointee = as->cray_pointee;
799       sym->as->cp_was_assumed = as->cp_was_assumed;
801       for (i = 0; i < sym->as->corank; i++)
803 	  sym->as->lower[as->rank + i] = sym->as->lower[i];
804 	  sym->as->upper[as->rank + i] = sym->as->upper[i];
806       for (i = 0; i < as->rank; i++)
808 	  sym->as->lower[i] = as->lower[i];
809 	  sym->as->upper[i] = as->upper[i];
813   free (as);
908    use the symbol as an implied-DO iterator.  Returns nonzero if a
1389    expression -- specification, restricted, or initialization as
1772    i=1,100000000) /) will take a while as* opposed to a more clever
1924    all elements are of compile-time known length, emit an error as this is
2023 	 length.  This is ok inside this conditional, as in the case above
2108 spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result)
2110   if (as == NULL)
2113   if (dimen < 0 || dimen > as->rank - 1)
2116   if (as->type != AS_EXPLICIT
2117       || as->lower[dimen]->expr_type != EXPR_CONSTANT
2118       || as->upper[dimen]->expr_type != EXPR_CONSTANT
2119       || as->lower[dimen]->ts.type != BT_INTEGER
2120       || as->upper[dimen]->ts.type != BT_INTEGER)
2125   mpz_sub (*result, as->upper[dimen]->value.integer,
2126 	   as->lower[dimen]->value.integer);
2135 spec_size (gfc_array_spec *as, mpz_t *result)
2140   if (!as || as->type == AS_ASSUMED_RANK)
2145   for (d = 0; d < as->rank; d++)
2147       if (!spec_dimen_size (as, d, &size))
2212 	 determine end as well, we cannot do this using gfc_dep_difference.
2222 	    use_dep = gfc_dep_difference (ar->as->upper[dimen],
2223 					    ar->as->lower[dimen], &diff);
2248 	  if (ar->as->lower[dimen] == NULL
2249 	      || ar->as->lower[dimen]->expr_type != EXPR_CONSTANT)
2251 	  mpz_set (lower, ar->as->lower[dimen]->value.integer);
2262 	  if (ar->as->upper[dimen] == NULL
2263 	      || ar->as->upper[dimen]->expr_type != EXPR_CONSTANT)
2265 	  mpz_set (upper, ar->as->upper[dimen]->value.integer);
2363 	    return spec_dimen_size (ref->u.ar.as, dimen, result);
2384 	  if (!spec_dimen_size (array->value.function.esym->as, dimen, result))
2387       else if (!spec_dimen_size (array->symtree->n.sym->as, dimen, result))
2458 	    return spec_size (ref->u.ar.as, result);
2464       return spec_size (array->symtree->n.sym->as, result);
2497       for (; d < ar->as->rank; d++)
2498 	if (!spec_dimen_size (ar->as, d, &shape[d]))
2549 gfc_is_compile_time_shape (gfc_array_spec *as)
2553   if (as->type != AS_EXPLICIT)
2556   for (i = 0; i < as->rank; i++)
2557     if (!gfc_is_constant_expr (as->lower[i])
2558 	|| !gfc_is_constant_expr (as->upper[i]))