gcc/fortran/data.c

   1 /* Supporting functions for resolving DATA statement.
   2    Copyright (C) 2002-2018 Free Software Foundation, Inc.
   3    Contributed by Lifang Zeng <zlf605@hotmail.com>
   4
   5 This file is part of GCC.
   6
   7 GCC is free software; you can redistribute it and/or modify it under
   8 the terms of the GNU General Public License as published by the Free
   9 Software Foundation; either version 3, or (at your option) any later
  10 version.
  11
  12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GCC; see the file COPYING3.  If not see
  19 <http://www.gnu.org/licenses/>.  */
  20
  21
  22 /* Notes for DATA statement implementation:
  23
  24    We first assign initial value to each symbol by gfc_assign_data_value
  25    during resolving DATA statement. Refer to check_data_variable and
  26    traverse_data_list in resolve.c.
  27
  28    The complexity exists in the handling of array section, implied do
  29    and array of struct appeared in DATA statement.
  30
  31    We call gfc_conv_structure, gfc_con_array_array_initializer,
  32    etc., to convert the initial value. Refer to trans-expr.c and
  33    trans-array.c.  */
  34
  35 #include "config.h"
  36 #include "system.h"
  37 #include "coretypes.h"
  38 #include "gfortran.h"
  39 #include "data.h"
  40 #include "constructor.h"
  41
  42 static void formalize_init_expr (gfc_expr *);
  43
  44 /* Calculate the array element offset.  */
  45
  46 static void
  47 get_array_index (gfc_array_ref *ar, mpz_t *offset)
  48 {
  49   gfc_expr *e;
  50   int i;
  51   mpz_t delta;
  52   mpz_t tmp;
  53
  54   mpz_init (tmp);
  55   mpz_set_si (*offset, 0);
  56   mpz_init_set_si (delta, 1);
  57   for (i = 0; i < ar->dimen; i++)
  58     {
  59       e = gfc_copy_expr (ar->start[i]);
  60       gfc_simplify_expr (e, 1);
  61
  62       if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
  63           || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
  64           || (gfc_is_constant_expr (e) == 0))
  65         gfc_error ("non-constant array in DATA statement %L", &ar->where);
  66
  67       mpz_set (tmp, e->value.integer);
  68       gfc_free_expr (e);
  69       mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
  70       mpz_mul (tmp, tmp, delta);
  71       mpz_add (*offset, tmp, *offset);
  72
  73       mpz_sub (tmp, ar->as->upper[i]->value.integer,
  74                ar->as->lower[i]->value.integer);
  75       mpz_add_ui (tmp, tmp, 1);
  76       mpz_mul (delta, tmp, delta);
  77     }
  78   mpz_clear (delta);
  79   mpz_clear (tmp);
  80 }
  81
  82 /* Find if there is a constructor which component is equal to COM.
  83    TODO: remove this, use symbol.c(gfc_find_component) instead.  */
  84
  85 static gfc_constructor *
  86 find_con_by_component (gfc_component *com, gfc_constructor_base base)
  87 {
  88   gfc_constructor *c;
  89
  90   for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
  91     if (com == c->n.component)
  92       return c;
  93
  94   return NULL;
  95 }
  96
  97
  98 /* Create a character type initialization expression from RVALUE.
  99    TS [and REF] describe [the substring of] the variable being initialized.
 100    INIT is the existing initializer, not NULL.  Initialization is performed
 101    according to normal assignment rules.  */
 102
 103 static gfc_expr *
 104 create_character_initializer (gfc_expr *init, gfc_typespec *ts,
 105                               gfc_ref *ref, gfc_expr *rvalue)
 106 {
 107   HOST_WIDE_INT len, start, end, tlen;
 108   gfc_char_t *dest;
 109   bool alloced_init = false;
 110
 111   gfc_extract_hwi (ts->u.cl->length, &len);
 112
 113   if (init == NULL)
 114     {
 115       /* Create a new initializer.  */
 116       init = gfc_get_character_expr (ts->kind, NULL, NULL, len);
 117       init->ts = *ts;
 118       alloced_init = true;
 119     }
 120
 121   dest = init->value.character.string;
 122
 123   if (ref)
 124     {
 125       gfc_expr *start_expr, *end_expr;
 126
 127       gcc_assert (ref->type == REF_SUBSTRING);
 128
 129       /* Only set a substring of the destination.  Fortran substring bounds
 130          are one-based [start, end], we want zero based [start, end).  */
 131       start_expr = gfc_copy_expr (ref->u.ss.start);
 132       end_expr = gfc_copy_expr (ref->u.ss.end);
 133
 134       if ((!gfc_simplify_expr(start_expr, 1))
 135           || !(gfc_simplify_expr(end_expr, 1)))
 136         {
 137           gfc_error ("failure to simplify substring reference in DATA "
 138                      "statement at %L", &ref->u.ss.start->where);
 139           gfc_free_expr (start_expr);
 140           gfc_free_expr (end_expr);
 141           if (alloced_init)
 142             gfc_free_expr (init);
 143           return NULL;
 144         }
 145
 146       gfc_extract_hwi (start_expr, &start);
 147       gfc_free_expr (start_expr);
 148       start--;
 149       gfc_extract_hwi (end_expr, &end);
 150       gfc_free_expr (end_expr);
 151     }
 152   else
 153     {
 154       /* Set the whole string.  */
 155       start = 0;
 156       end = len;
 157     }
 158
 159   /* Copy the initial value.  */
 160   if (rvalue->ts.type == BT_HOLLERITH)
 161     len = rvalue->representation.length - rvalue->ts.u.pad;
 162   else
 163     len = rvalue->value.character.length;
 164
 165   tlen = end - start;
 166   if (len > tlen)
 167     {
 168       if (tlen < 0)
 169         {
 170           gfc_warning_now (0, "Unused initialization string at %L because "
 171                            "variable has zero length", &rvalue->where);
 172           len = 0;
 173         }
 174       else
 175         {
 176           gfc_warning_now (0, "Initialization string at %L was truncated to "
 177                            "fit the variable (%ld/%ld)", &rvalue->where,
 178                            (long) tlen, (long) len);
 179           len = tlen;
 180         }
 181     }
 182
 183   if (rvalue->ts.type == BT_HOLLERITH)
 184     {
 185       for (size_t i = 0; i < (size_t) len; i++)
 186         dest[start+i] = rvalue->representation.string[i];
 187     }
 188   else
 189     memcpy (&dest[start], rvalue->value.character.string,
 190             len * sizeof (gfc_char_t));
 191
 192   /* Pad with spaces.  Substrings will already be blanked.  */
 193   if (len < tlen && ref == NULL)
 194     gfc_wide_memset (&dest[start + len], ' ', end - (start + len));
 195
 196   if (rvalue->ts.type == BT_HOLLERITH)
 197     {
 198       init->representation.length = init->value.character.length;
 199       init->representation.string
 200         = gfc_widechar_to_char (init->value.character.string,
 201                                 init->value.character.length);
 202     }
 203
 204   return init;
 205 }
 206
 207
 208 /* Assign the initial value RVALUE to  LVALUE's symbol->value. If the
 209    LVALUE already has an initialization, we extend this, otherwise we
 210    create a new one.  If REPEAT is non-NULL, initialize *REPEAT
 211    consecutive values in LVALUE the same value in RVALUE.  In that case,
 212    LVALUE must refer to a full array, not an array section.  */
 213
 214 bool
 215 gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
 216                        mpz_t *repeat)
 217 {
 218   gfc_ref *ref;
 219   gfc_expr *init;
 220   gfc_expr *expr = NULL;
 221   gfc_constructor *con;
 222   gfc_constructor *last_con;
 223   gfc_symbol *symbol;
 224   gfc_typespec *last_ts;
 225   mpz_t offset;
 226
 227   symbol = lvalue->symtree->n.sym;
 228   init = symbol->value;
 229   last_ts = &symbol->ts;
 230   last_con = NULL;
 231   mpz_init_set_si (offset, 0);
 232
 233   /* Find/create the parent expressions for subobject references.  */
 234   for (ref = lvalue->ref; ref; ref = ref->next)
 235     {
 236       /* Break out of the loop if we find a substring.  */
 237       if (ref->type == REF_SUBSTRING)
 238         {
 239           /* A substring should always be the last subobject reference.  */
 240           gcc_assert (ref->next == NULL);
 241           break;
 242         }
 243
 244       /* Use the existing initializer expression if it exists.  Otherwise
 245          create a new one.  */
 246       if (init == NULL)
 247         expr = gfc_get_expr ();
 248       else
 249         expr = init;
 250
 251       /* Find or create this element.  */
 252       switch (ref->type)
 253         {
 254         case REF_ARRAY:
 255           if (ref->u.ar.as->rank == 0)
 256             {
 257               gcc_assert (ref->u.ar.as->corank > 0);
 258               if (init == NULL)
 259                 free (expr);
 260               continue;
 261             }
 262
 263           if (init && expr->expr_type != EXPR_ARRAY)
 264             {
 265               gfc_error ("%qs at %L already is initialized at %L",
 266                          lvalue->symtree->n.sym->name, &lvalue->where,
 267                          &init->where);
 268               goto abort;
 269             }
 270
 271           if (init == NULL)
 272             {
 273               /* The element typespec will be the same as the array
 274                  typespec.  */
 275               expr->ts = *last_ts;
 276               /* Setup the expression to hold the constructor.  */
 277               expr->expr_type = EXPR_ARRAY;
 278               expr->rank = ref->u.ar.as->rank;
 279             }
 280
 281           if (ref->u.ar.type == AR_ELEMENT)
 282             get_array_index (&ref->u.ar, &offset);
 283           else
 284             mpz_set (offset, index);
 285
 286           /* Check the bounds.  */
 287           if (mpz_cmp_si (offset, 0) < 0)
 288             {
 289               gfc_error ("Data element below array lower bound at %L",
 290                          &lvalue->where);
 291               goto abort;
 292             }
 293           else if (repeat != NULL
 294                    && ref->u.ar.type != AR_ELEMENT)
 295             {
 296               mpz_t size, end;
 297               gcc_assert (ref->u.ar.type == AR_FULL
 298                           && ref->next == NULL);
 299               mpz_init_set (end, offset);
 300               mpz_add (end, end, *repeat);
 301               if (spec_size (ref->u.ar.as, &size))
 302                 {
 303                   if (mpz_cmp (end, size) > 0)
 304                     {
 305                       mpz_clear (size);
 306                       gfc_error ("Data element above array upper bound at %L",
 307                                  &lvalue->where);
 308                       goto abort;
 309                     }
 310                   mpz_clear (size);
 311                 }
 312
 313               con = gfc_constructor_lookup (expr->value.constructor,
 314                                             mpz_get_si (offset));
 315               if (!con)
 316                 {
 317                   con = gfc_constructor_lookup_next (expr->value.constructor,
 318                                                      mpz_get_si (offset));
 319                   if (con != NULL && mpz_cmp (con->offset, end) >= 0)
 320                     con = NULL;
 321                 }
 322
 323               /* Overwriting an existing initializer is non-standard but
 324                  usually only provokes a warning from other compilers.  */
 325               if (con != NULL && con->expr != NULL)
 326                 {
 327                   /* Order in which the expressions arrive here depends on
 328                      whether they are from data statements or F95 style
 329                      declarations.  Therefore, check which is the most
 330                      recent.  */
 331                   gfc_expr *exprd;
 332                   exprd = (LOCATION_LINE (con->expr->where.lb->location)
 333                            > LOCATION_LINE (rvalue->where.lb->location))
 334                           ? con->expr : rvalue;
 335                   if (gfc_notify_std (GFC_STD_GNU,
 336                                       "re-initialization of %qs at %L",
 337                                       symbol->name, &exprd->where) == false)
 338                     return false;
 339                 }
 340
 341               while (con != NULL)
 342                 {
 343                   gfc_constructor *next_con = gfc_constructor_next (con);
 344
 345                   if (mpz_cmp (con->offset, end) >= 0)
 346                     break;
 347                   if (mpz_cmp (con->offset, offset) < 0)
 348                     {
 349                       gcc_assert (mpz_cmp_si (con->repeat, 1) > 0);
 350                       mpz_sub (con->repeat, offset, con->offset);
 351                     }
 352                   else if (mpz_cmp_si (con->repeat, 1) > 0
 353                            && mpz_get_si (con->offset)
 354                               + mpz_get_si (con->repeat) > mpz_get_si (end))
 355                     {
 356                       int endi;
 357                       splay_tree_node node
 358                         = splay_tree_lookup (con->base,
 359                                              mpz_get_si (con->offset));
 360                       gcc_assert (node
 361                                   && con == (gfc_constructor *) node->value
 362                                   && node->key == (splay_tree_key)
 363                                                   mpz_get_si (con->offset));
 364                       endi = mpz_get_si (con->offset)
 365                              + mpz_get_si (con->repeat);
 366                       if (endi > mpz_get_si (end) + 1)
 367                         mpz_set_si (con->repeat, endi - mpz_get_si (end));
 368                       else
 369                         mpz_set_si (con->repeat, 1);
 370                       mpz_set (con->offset, end);
 371                       node->key = (splay_tree_key) mpz_get_si (end);
 372                       break;
 373                     }
 374                   else
 375                     gfc_constructor_remove (con);
 376                   con = next_con;
 377                 }
 378
 379               con = gfc_constructor_insert_expr (&expr->value.constructor,
 380                                                  NULL, &rvalue->where,
 381                                                  mpz_get_si (offset));
 382               mpz_set (con->repeat, *repeat);
 383               repeat = NULL;
 384               mpz_clear (end);
 385               break;
 386             }
 387           else
 388             {
 389               mpz_t size;
 390               if (spec_size (ref->u.ar.as, &size))
 391                 {
 392                   if (mpz_cmp (offset, size) >= 0)
 393                     {
 394                       mpz_clear (size);
 395                       gfc_error ("Data element above array upper bound at %L",
 396                                  &lvalue->where);
 397                       goto abort;
 398                     }
 399                   mpz_clear (size);
 400                 }
 401             }
 402
 403           con = gfc_constructor_lookup (expr->value.constructor,
 404                                         mpz_get_si (offset));
 405           if (!con)
 406             {
 407               con = gfc_constructor_insert_expr (&expr->value.constructor,
 408                                                  NULL, &rvalue->where,
 409                                                  mpz_get_si (offset));
 410             }
 411           else if (mpz_cmp_si (con->repeat, 1) > 0)
 412             {
 413               /* Need to split a range.  */
 414               if (mpz_cmp (con->offset, offset) < 0)
 415                 {
 416                   gfc_constructor *pred_con = con;
 417                   con = gfc_constructor_insert_expr (&expr->value.constructor,
 418                                                      NULL, &con->where,
 419                                                      mpz_get_si (offset));
 420                   con->expr = gfc_copy_expr (pred_con->expr);
 421                   mpz_add (con->repeat, pred_con->offset, pred_con->repeat);
 422                   mpz_sub (con->repeat, con->repeat, offset);
 423                   mpz_sub (pred_con->repeat, offset, pred_con->offset);
 424                 }
 425               if (mpz_cmp_si (con->repeat, 1) > 0)
 426                 {
 427                   gfc_constructor *succ_con;
 428                   succ_con
 429                     = gfc_constructor_insert_expr (&expr->value.constructor,
 430                                                    NULL, &con->where,
 431                                                    mpz_get_si (offset) + 1);
 432                   succ_con->expr = gfc_copy_expr (con->expr);
 433                   mpz_sub_ui (succ_con->repeat, con->repeat, 1);
 434                   mpz_set_si (con->repeat, 1);
 435                 }
 436             }
 437           break;
 438
 439         case REF_COMPONENT:
 440           if (init == NULL)
 441             {
 442               /* Setup the expression to hold the constructor.  */
 443               expr->expr_type = EXPR_STRUCTURE;
 444               expr->ts.type = BT_DERIVED;
 445               expr->ts.u.derived = ref->u.c.sym;
 446             }
 447           else
 448             gcc_assert (expr->expr_type == EXPR_STRUCTURE);
 449           last_ts = &ref->u.c.component->ts;
 450
 451           /* Find the same element in the existing constructor.  */
 452           con = find_con_by_component (ref->u.c.component,
 453                                        expr->value.constructor);
 454
 455           if (con == NULL)
 456             {
 457               /* Create a new constructor.  */
 458               con = gfc_constructor_append_expr (&expr->value.constructor,
 459                                                  NULL, NULL);
 460               con->n.component = ref->u.c.component;
 461             }
 462           break;
 463
 464         default:
 465           gcc_unreachable ();
 466         }
 467
 468       if (init == NULL)
 469         {
 470           /* Point the container at the new expression.  */
 471           if (last_con == NULL)
 472             symbol->value = expr;
 473           else
 474             last_con->expr = expr;
 475         }
 476       init = con->expr;
 477       last_con = con;
 478     }
 479
 480   mpz_clear (offset);
 481   gcc_assert (repeat == NULL);
 482
 483   if (ref || last_ts->type == BT_CHARACTER)
 484     {
 485       /* An initializer has to be constant.  */
 486       if (rvalue->expr_type != EXPR_CONSTANT
 487           || (lvalue->ts.u.cl->length == NULL
 488               && !(ref && ref->u.ss.length != NULL)))
 489         return false;
 490       expr = create_character_initializer (init, last_ts, ref, rvalue);
 491     }
 492   else
 493     {
 494       /* Overwriting an existing initializer is non-standard but usually only
 495          provokes a warning from other compilers.  */
 496       if (init != NULL)
 497         {
 498           /* Order in which the expressions arrive here depends on whether
 499              they are from data statements or F95 style declarations.
 500              Therefore, check which is the most recent.  */
 501           expr = (LOCATION_LINE (init->where.lb->location)
 502                   > LOCATION_LINE (rvalue->where.lb->location))
 503                ? init : rvalue;
 504           if (gfc_notify_std (GFC_STD_GNU,
 505                               "re-initialization of %qs at %L",
 506                               symbol->name, &expr->where) == false)
 507             return false;
 508         }
 509
 510       expr = gfc_copy_expr (rvalue);
 511       if (!gfc_compare_types (&lvalue->ts, &expr->ts))
 512         gfc_convert_type (expr, &lvalue->ts, 0);
 513     }
 514
 515   if (last_con == NULL)
 516     symbol->value = expr;
 517   else
 518     last_con->expr = expr;
 519
 520   return true;
 521
 522 abort:
 523   if (!init)
 524     gfc_free_expr (expr);
 525   mpz_clear (offset);
 526   return false;
 527 }
 528
 529
 530 /* Modify the index of array section and re-calculate the array offset.  */
 531
 532 void
 533 gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
 534                      mpz_t *offset_ret)
 535 {
 536   int i;
 537   mpz_t delta;
 538   mpz_t tmp;
 539   bool forwards;
 540   int cmp;
 541   gfc_expr *start, *end, *stride;
 542
 543   for (i = 0; i < ar->dimen; i++)
 544     {
 545       if (ar->dimen_type[i] != DIMEN_RANGE)
 546         continue;
 547
 548       if (ar->stride[i])
 549         {
 550           stride = gfc_copy_expr(ar->stride[i]);
 551           if(!gfc_simplify_expr(stride, 1))
 552             gfc_internal_error("Simplification error");
 553           mpz_add (section_index[i], section_index[i],
 554                    stride->value.integer);
 555           if (mpz_cmp_si (stride->value.integer, 0) >= 0)
 556             forwards = true;
 557           else
 558             forwards = false;
 559           gfc_free_expr(stride);
 560         }
 561       else
 562         {
 563           mpz_add_ui (section_index[i], section_index[i], 1);
 564           forwards = true;
 565         }
 566
 567       if (ar->end[i])
 568         {
 569           end = gfc_copy_expr(ar->end[i]);
 570           if(!gfc_simplify_expr(end, 1))
 571             gfc_internal_error("Simplification error");
 572           cmp = mpz_cmp (section_index[i], end->value.integer);
 573           gfc_free_expr(end);
 574         }
 575       else
 576         cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
 577
 578       if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
 579         {
 580           /* Reset index to start, then loop to advance the next index.  */
 581           if (ar->start[i])
 582             {
 583               start = gfc_copy_expr(ar->start[i]);
 584               if(!gfc_simplify_expr(start, 1))
 585                 gfc_internal_error("Simplification error");
 586               mpz_set (section_index[i], start->value.integer);
 587               gfc_free_expr(start);
 588             }
 589           else
 590             mpz_set (section_index[i], ar->as->lower[i]->value.integer);
 591         }
 592       else
 593         break;
 594     }
 595
 596   mpz_set_si (*offset_ret, 0);
 597   mpz_init_set_si (delta, 1);
 598   mpz_init (tmp);
 599   for (i = 0; i < ar->dimen; i++)
 600     {
 601       mpz_sub (tmp, section_index[i], ar->as->lower[i]->value.integer);
 602       mpz_mul (tmp, tmp, delta);
 603       mpz_add (*offset_ret, tmp, *offset_ret);
 604
 605       mpz_sub (tmp, ar->as->upper[i]->value.integer,
 606                ar->as->lower[i]->value.integer);
 607       mpz_add_ui (tmp, tmp, 1);
 608       mpz_mul (delta, tmp, delta);
 609     }
 610   mpz_clear (tmp);
 611   mpz_clear (delta);
 612 }
 613
 614
 615 /* Rearrange a structure constructor so the elements are in the specified
 616    order.  Also insert NULL entries if necessary.  */
 617
 618 static void
 619 formalize_structure_cons (gfc_expr *expr)
 620 {
 621   gfc_constructor_base base = NULL;
 622   gfc_constructor *cur;
 623   gfc_component *order;
 624
 625   /* Constructor is already formalized.  */
 626   cur = gfc_constructor_first (expr->value.constructor);
 627   if (!cur || cur->n.component == NULL)
 628     return;
 629
 630   for (order = expr->ts.u.derived->components; order; order = order->next)
 631     {
 632       cur = find_con_by_component (order, expr->value.constructor);
 633       if (cur)
 634         gfc_constructor_append_expr (&base, cur->expr, &cur->expr->where);
 635       else
 636         gfc_constructor_append_expr (&base, NULL, NULL);
 637     }
 638
 639   /* For all what it's worth, one would expect
 640        gfc_constructor_free (expr->value.constructor);
 641      here. However, if the constructor is actually free'd,
 642      hell breaks loose in the testsuite?!  */
 643
 644   expr->value.constructor = base;
 645 }
 646
 647
 648 /* Make sure an initialization expression is in normalized form, i.e., all
 649    elements of the constructors are in the correct order.  */
 650
 651 static void
 652 formalize_init_expr (gfc_expr *expr)
 653 {
 654   expr_t type;
 655   gfc_constructor *c;
 656
 657   if (expr == NULL)
 658     return;
 659
 660   type = expr->expr_type;
 661   switch (type)
 662     {
 663     case EXPR_ARRAY:
 664       for (c = gfc_constructor_first (expr->value.constructor);
 665            c; c = gfc_constructor_next (c))
 666         formalize_init_expr (c->expr);
 667
 668     break;
 669
 670     case EXPR_STRUCTURE:
 671       formalize_structure_cons (expr);
 672       break;
 673
 674     default:
 675       break;
 676     }
 677 }
 678
 679
 680 /* Resolve symbol's initial value after all data statement.  */
 681
 682 void
 683 gfc_formalize_init_value (gfc_symbol *sym)
 684 {
 685   formalize_init_expr (sym->value);
 686 }
 687
 688
 689 /* Get the integer value into RET_AS and SECTION from AS and AR, and return
 690    offset.  */
 691
 692 void
 693 gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
 694 {
 695   int i;
 696   mpz_t delta;
 697   mpz_t tmp;
 698   gfc_expr *start;
 699
 700   mpz_set_si (*offset, 0);
 701   mpz_init (tmp);
 702   mpz_init_set_si (delta, 1);
 703   for (i = 0; i < ar->dimen; i++)
 704     {
 705       mpz_init (section_index[i]);
 706       switch (ar->dimen_type[i])
 707         {
 708         case DIMEN_ELEMENT:
 709         case DIMEN_RANGE:
 710           if (ar->start[i])
 711             {
 712               start = gfc_copy_expr(ar->start[i]);
 713               if(!gfc_simplify_expr(start, 1))
 714                 gfc_internal_error("Simplification error");
 715               mpz_sub (tmp, start->value.integer,
 716                        ar->as->lower[i]->value.integer);
 717               mpz_mul (tmp, tmp, delta);
 718               mpz_add (*offset, tmp, *offset);
 719               mpz_set (section_index[i], start->value.integer);
 720               gfc_free_expr(start);
 721             }
 722           else
 723               mpz_set (section_index[i], ar->as->lower[i]->value.integer);
 724           break;
 725
 726         case DIMEN_VECTOR:
 727           gfc_internal_error ("TODO: Vector sections in data statements");
 728
 729         default:
 730           gcc_unreachable ();
 731         }
 732
 733       mpz_sub (tmp, ar->as->upper[i]->value.integer,
 734                ar->as->lower[i]->value.integer);
 735       mpz_add_ui (tmp, tmp, 1);
 736       mpz_mul (delta, tmp, delta);
 737     }
 738
 739   mpz_clear (tmp);
 740   mpz_clear (delta);
 741 }
 742