1 /* Supporting functions for resolving DATA statement.
2 Copyright (C) 2002-2024 Free Software Foundation, Inc.
3 Contributed by Lifang Zeng <zlf605@hotmail.com>
5 This file is part of GCC.
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
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
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/>. */
22 /* Notes for DATA statement implementation:
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.cc.
28 The complexity exists in the handling of array section, implied do
29 and array of struct appeared in DATA statement.
31 We call gfc_conv_structure, gfc_con_array_array_initializer,
32 etc., to convert the initial value. Refer to trans-expr.cc and
37 #include "coretypes.h"
40 #include "constructor.h"
42 static void formalize_init_expr (gfc_expr
*);
44 /* Calculate the array element offset. */
47 get_array_index (gfc_array_ref
*ar
, mpz_t
*offset
)
56 mpz_set_si (*offset
, 0);
57 mpz_init_set_si (delta
, 1);
58 for (i
= 0; i
< ar
->dimen
; i
++)
60 e
= gfc_copy_expr (ar
->start
[i
]);
61 gfc_simplify_expr (e
, 1);
63 if (!gfc_is_constant_expr (ar
->as
->lower
[i
])
64 || !gfc_is_constant_expr (ar
->as
->upper
[i
])
65 || !gfc_is_constant_expr (e
))
67 gfc_error ("non-constant array in DATA statement %L", &ar
->where
);
72 mpz_set (tmp
, e
->value
.integer
);
75 /* Overindexing is only allowed as a legacy extension. */
76 if (mpz_cmp (tmp
, ar
->as
->lower
[i
]->value
.integer
) < 0
77 && !gfc_notify_std (GFC_STD_LEGACY
,
78 "Subscript at %L below array lower bound "
79 "(%ld < %ld) in dimension %d", &ar
->c_where
[i
],
81 mpz_get_si (ar
->as
->lower
[i
]->value
.integer
),
87 if (mpz_cmp (tmp
, ar
->as
->upper
[i
]->value
.integer
) > 0
88 && !gfc_notify_std (GFC_STD_LEGACY
,
89 "Subscript at %L above array upper bound "
90 "(%ld > %ld) in dimension %d", &ar
->c_where
[i
],
92 mpz_get_si (ar
->as
->upper
[i
]->value
.integer
),
99 mpz_sub (tmp
, tmp
, ar
->as
->lower
[i
]->value
.integer
);
100 mpz_mul (tmp
, tmp
, delta
);
101 mpz_add (*offset
, tmp
, *offset
);
103 mpz_sub (tmp
, ar
->as
->upper
[i
]->value
.integer
,
104 ar
->as
->lower
[i
]->value
.integer
);
105 mpz_add_ui (tmp
, tmp
, 1);
106 mpz_mul (delta
, tmp
, delta
);
114 /* Find if there is a constructor which component is equal to COM.
115 TODO: remove this, use symbol.cc(gfc_find_component) instead. */
117 static gfc_constructor
*
118 find_con_by_component (gfc_component
*com
, gfc_constructor_base base
)
122 for (c
= gfc_constructor_first (base
); c
; c
= gfc_constructor_next (c
))
123 if (com
== c
->n
.component
)
130 /* Create a character type initialization expression from RVALUE.
131 TS [and REF] describe [the substring of] the variable being initialized.
132 INIT is the existing initializer, not NULL. Initialization is performed
133 according to normal assignment rules. */
136 create_character_initializer (gfc_expr
*init
, gfc_typespec
*ts
,
137 gfc_ref
*ref
, gfc_expr
*rvalue
)
139 HOST_WIDE_INT len
, start
, end
, tlen
;
141 bool alloced_init
= false;
143 if (init
&& init
->ts
.type
!= BT_CHARACTER
)
146 gfc_extract_hwi (ts
->u
.cl
->length
, &len
);
150 /* Create a new initializer. */
151 init
= gfc_get_character_expr (ts
->kind
, NULL
, NULL
, len
);
156 dest
= init
->value
.character
.string
;
160 gfc_expr
*start_expr
, *end_expr
;
162 gcc_assert (ref
->type
== REF_SUBSTRING
);
164 /* Only set a substring of the destination. Fortran substring bounds
165 are one-based [start, end], we want zero based [start, end). */
166 start_expr
= gfc_copy_expr (ref
->u
.ss
.start
);
167 end_expr
= gfc_copy_expr (ref
->u
.ss
.end
);
169 if ((!gfc_simplify_expr(start_expr
, 1))
170 || !(gfc_simplify_expr(end_expr
, 1)))
172 gfc_error ("failure to simplify substring reference in DATA "
173 "statement at %L", &ref
->u
.ss
.start
->where
);
174 gfc_free_expr (start_expr
);
175 gfc_free_expr (end_expr
);
177 gfc_free_expr (init
);
181 gfc_extract_hwi (start_expr
, &start
);
182 gfc_free_expr (start_expr
);
184 gfc_extract_hwi (end_expr
, &end
);
185 gfc_free_expr (end_expr
);
189 /* Set the whole string. */
194 /* Copy the initial value. */
195 if (rvalue
->ts
.type
== BT_HOLLERITH
)
196 len
= rvalue
->representation
.length
- rvalue
->ts
.u
.pad
;
198 len
= rvalue
->value
.character
.length
;
205 gfc_warning_now (0, "Unused initialization string at %L because "
206 "variable has zero length", &rvalue
->where
);
211 gfc_warning_now (0, "Initialization string at %L was truncated to "
212 "fit the variable (%ld/%ld)", &rvalue
->where
,
213 (long) tlen
, (long) len
);
220 gfc_error ("Substring start index at %L is less than one",
221 &ref
->u
.ss
.start
->where
);
224 if (end
> init
->value
.character
.length
)
226 gfc_error ("Substring end index at %L exceeds the string length",
227 &ref
->u
.ss
.end
->where
);
231 if (rvalue
->ts
.type
== BT_HOLLERITH
)
233 for (size_t i
= 0; i
< (size_t) len
; i
++)
234 dest
[start
+i
] = rvalue
->representation
.string
[i
];
237 memcpy (&dest
[start
], rvalue
->value
.character
.string
,
238 len
* sizeof (gfc_char_t
));
240 /* Pad with spaces. Substrings will already be blanked. */
241 if (len
< tlen
&& ref
== NULL
)
242 gfc_wide_memset (&dest
[start
+ len
], ' ', end
- (start
+ len
));
244 if (rvalue
->ts
.type
== BT_HOLLERITH
)
246 init
->representation
.length
= init
->value
.character
.length
;
247 init
->representation
.string
248 = gfc_widechar_to_char (init
->value
.character
.string
,
249 init
->value
.character
.length
);
256 /* Assign the initial value RVALUE to LVALUE's symbol->value. If the
257 LVALUE already has an initialization, we extend this, otherwise we
258 create a new one. If REPEAT is non-NULL, initialize *REPEAT
259 consecutive values in LVALUE the same value in RVALUE. In that case,
260 LVALUE must refer to a full array, not an array section. */
263 gfc_assign_data_value (gfc_expr
*lvalue
, gfc_expr
*rvalue
, mpz_t index
,
268 gfc_expr
*expr
= NULL
;
270 gfc_constructor
*con
;
271 gfc_constructor
*last_con
;
273 gfc_typespec
*last_ts
;
275 const char *msg
= "F18(R841): data-implied-do object at %L is neither an "
276 "array-element nor a scalar-structure-component";
278 symbol
= lvalue
->symtree
->n
.sym
;
279 init
= symbol
->value
;
280 last_ts
= &symbol
->ts
;
282 mpz_init_set_si (offset
, 0);
284 /* Find/create the parent expressions for subobject references. */
285 for (ref
= lvalue
->ref
; ref
; ref
= ref
->next
)
287 /* Break out of the loop if we find a substring. */
288 if (ref
->type
== REF_SUBSTRING
)
290 /* A substring should always be the last subobject reference. */
291 gcc_assert (ref
->next
== NULL
);
295 /* Use the existing initializer expression if it exists. Otherwise
298 expr
= gfc_get_expr ();
302 /* Find or create this element. */
306 if (ref
->u
.ar
.as
->rank
== 0)
308 gcc_assert (ref
->u
.ar
.as
->corank
> 0);
314 if (init
&& expr
->expr_type
!= EXPR_ARRAY
)
316 gfc_error ("%qs at %L already is initialized at %L",
317 lvalue
->symtree
->n
.sym
->name
, &lvalue
->where
,
324 /* The element typespec will be the same as the array
327 /* Setup the expression to hold the constructor. */
328 expr
->expr_type
= EXPR_ARRAY
;
329 expr
->rank
= ref
->u
.ar
.as
->rank
;
332 if (ref
->u
.ar
.type
== AR_ELEMENT
)
334 if (!get_array_index (&ref
->u
.ar
, &offset
))
338 mpz_set (offset
, index
);
340 /* Check the bounds. */
341 if (mpz_cmp_si (offset
, 0) < 0)
343 gfc_error ("Data element below array lower bound at %L",
347 else if (repeat
!= NULL
348 && ref
->u
.ar
.type
!= AR_ELEMENT
)
351 gcc_assert (ref
->u
.ar
.type
== AR_FULL
352 && ref
->next
== NULL
);
353 mpz_init_set (end
, offset
);
354 mpz_add (end
, end
, *repeat
);
355 if (spec_size (ref
->u
.ar
.as
, &size
))
357 if (mpz_cmp (end
, size
) > 0)
360 gfc_error ("Data element above array upper bound at %L",
367 con
= gfc_constructor_lookup (expr
->value
.constructor
,
368 mpz_get_si (offset
));
371 con
= gfc_constructor_lookup_next (expr
->value
.constructor
,
372 mpz_get_si (offset
));
373 if (con
!= NULL
&& mpz_cmp (con
->offset
, end
) >= 0)
377 /* Overwriting an existing initializer is non-standard but
378 usually only provokes a warning from other compilers. */
379 if (con
!= NULL
&& con
->expr
!= NULL
)
381 /* Order in which the expressions arrive here depends on
382 whether they are from data statements or F95 style
383 declarations. Therefore, check which is the most
386 exprd
= (LOCATION_LINE (con
->expr
->where
.lb
->location
)
387 > LOCATION_LINE (rvalue
->where
.lb
->location
))
388 ? con
->expr
: rvalue
;
389 if (gfc_notify_std (GFC_STD_GNU
,
390 "re-initialization of %qs at %L",
391 symbol
->name
, &exprd
->where
) == false)
397 gfc_constructor
*next_con
= gfc_constructor_next (con
);
399 if (mpz_cmp (con
->offset
, end
) >= 0)
401 if (mpz_cmp (con
->offset
, offset
) < 0)
403 gcc_assert (mpz_cmp_si (con
->repeat
, 1) > 0);
404 mpz_sub (con
->repeat
, offset
, con
->offset
);
406 else if (mpz_cmp_si (con
->repeat
, 1) > 0
407 && mpz_get_si (con
->offset
)
408 + mpz_get_si (con
->repeat
) > mpz_get_si (end
))
412 = splay_tree_lookup (con
->base
,
413 mpz_get_si (con
->offset
));
415 && con
== (gfc_constructor
*) node
->value
416 && node
->key
== (splay_tree_key
)
417 mpz_get_si (con
->offset
));
418 endi
= mpz_get_si (con
->offset
)
419 + mpz_get_si (con
->repeat
);
420 if (endi
> mpz_get_si (end
) + 1)
421 mpz_set_si (con
->repeat
, endi
- mpz_get_si (end
));
423 mpz_set_si (con
->repeat
, 1);
424 mpz_set (con
->offset
, end
);
425 node
->key
= (splay_tree_key
) mpz_get_si (end
);
429 gfc_constructor_remove (con
);
433 con
= gfc_constructor_insert_expr (&expr
->value
.constructor
,
434 NULL
, &rvalue
->where
,
435 mpz_get_si (offset
));
436 mpz_set (con
->repeat
, *repeat
);
444 if (spec_size (ref
->u
.ar
.as
, &size
))
446 if (mpz_cmp (offset
, size
) >= 0)
449 gfc_error ("Data element above array upper bound at %L",
457 con
= gfc_constructor_lookup (expr
->value
.constructor
,
458 mpz_get_si (offset
));
461 con
= gfc_constructor_insert_expr (&expr
->value
.constructor
,
462 NULL
, &rvalue
->where
,
463 mpz_get_si (offset
));
465 else if (mpz_cmp_si (con
->repeat
, 1) > 0)
467 /* Need to split a range. */
468 if (mpz_cmp (con
->offset
, offset
) < 0)
470 gfc_constructor
*pred_con
= con
;
471 con
= gfc_constructor_insert_expr (&expr
->value
.constructor
,
473 mpz_get_si (offset
));
474 con
->expr
= gfc_copy_expr (pred_con
->expr
);
475 mpz_add (con
->repeat
, pred_con
->offset
, pred_con
->repeat
);
476 mpz_sub (con
->repeat
, con
->repeat
, offset
);
477 mpz_sub (pred_con
->repeat
, offset
, pred_con
->offset
);
479 if (mpz_cmp_si (con
->repeat
, 1) > 0)
481 gfc_constructor
*succ_con
;
483 = gfc_constructor_insert_expr (&expr
->value
.constructor
,
485 mpz_get_si (offset
) + 1);
486 succ_con
->expr
= gfc_copy_expr (con
->expr
);
487 mpz_sub_ui (succ_con
->repeat
, con
->repeat
, 1);
488 mpz_set_si (con
->repeat
, 1);
496 /* Setup the expression to hold the constructor. */
497 expr
->expr_type
= EXPR_STRUCTURE
;
498 expr
->ts
.type
= BT_DERIVED
;
499 expr
->ts
.u
.derived
= ref
->u
.c
.sym
;
502 gcc_assert (expr
->expr_type
== EXPR_STRUCTURE
);
503 last_ts
= &ref
->u
.c
.component
->ts
;
505 /* Find the same element in the existing constructor. */
506 con
= find_con_by_component (ref
->u
.c
.component
,
507 expr
->value
.constructor
);
511 /* Create a new constructor. */
512 con
= gfc_constructor_append_expr (&expr
->value
.constructor
,
514 con
->n
.component
= ref
->u
.c
.component
;
520 /* After some discussion on clf it was determined that the following
521 violates F18(R841). If the error is removed, the expected result
522 is obtained. Leaving the code in place ensures a clean error
524 gfc_error (msg
, &lvalue
->where
);
526 /* This breaks with the other reference types in that the output
527 constructor has to be of type COMPLEX, whereas the lvalue is
528 of type REAL. The rvalue is copied to the real or imaginary
529 part as appropriate. In addition, for all except scalar
530 complex variables, a complex expression has to provided, where
531 the constructor does not have it, and the expression modified
532 with a new value for the real or imaginary part. */
533 gcc_assert (ref
->next
== NULL
&& last_ts
->type
== BT_COMPLEX
);
534 rexpr
= gfc_copy_expr (rvalue
);
535 if (!gfc_compare_types (&lvalue
->ts
, &rexpr
->ts
))
536 gfc_convert_type (rexpr
, &lvalue
->ts
, 0);
538 /* This is the scalar, complex case, where an initializer exists. */
539 if (init
&& ref
== lvalue
->ref
)
540 expr
= symbol
->value
;
541 /* Then all cases, where a complex expression does not exist. */
542 else if (!last_con
|| !last_con
->expr
)
544 expr
= gfc_get_constant_expr (BT_COMPLEX
, lvalue
->ts
.kind
,
547 last_con
->expr
= expr
;
550 /* Finally, and existing constructor expression to be modified. */
551 expr
= last_con
->expr
;
553 /* Rejection of LEN and KIND inquiry references is handled
554 elsewhere. The error here is added as backup. The assertion
555 of F2008 for RE and IM is also done elsewhere. */
560 gfc_error ("LEN or KIND inquiry ref in DATA statement at %L",
564 mpfr_set (mpc_realref (expr
->value
.complex),
569 mpfr_set (mpc_imagref (expr
->value
.complex),
575 /* Only the scalar, complex expression needs to be saved as the
576 symbol value since the last constructor expression is already
577 provided as the initializer in the code after the reference
579 if (ref
== lvalue
->ref
)
580 symbol
->value
= expr
;
582 gfc_free_expr (rexpr
);
592 /* Point the container at the new expression. */
593 if (last_con
== NULL
)
594 symbol
->value
= expr
;
596 last_con
->expr
= expr
;
603 gcc_assert (repeat
== NULL
);
605 /* Overwriting an existing initializer is non-standard but usually only
606 provokes a warning from other compilers. */
607 if (init
!= NULL
&& init
->where
.lb
&& rvalue
->where
.lb
)
609 /* Order in which the expressions arrive here depends on whether
610 they are from data statements or F95 style declarations.
611 Therefore, check which is the most recent. */
612 expr
= (LOCATION_LINE (init
->where
.lb
->location
)
613 > LOCATION_LINE (rvalue
->where
.lb
->location
))
615 if (gfc_notify_std (GFC_STD_GNU
, "re-initialization of %qs at %L",
616 symbol
->name
, &expr
->where
) == false)
620 if (ref
|| (last_ts
->type
== BT_CHARACTER
621 && rvalue
->expr_type
== EXPR_CONSTANT
))
623 /* An initializer has to be constant. */
624 if (lvalue
->ts
.u
.cl
->length
== NULL
&& !(ref
&& ref
->u
.ss
.length
!= NULL
))
626 if (lvalue
->ts
.u
.cl
->length
627 && lvalue
->ts
.u
.cl
->length
->expr_type
!= EXPR_CONSTANT
)
629 expr
= create_character_initializer (init
, last_ts
, ref
, rvalue
);
635 if (lvalue
->ts
.type
== BT_DERIVED
636 && gfc_has_default_initializer (lvalue
->ts
.u
.derived
))
638 gfc_error ("Nonpointer object %qs with default initialization "
639 "shall not appear in a DATA statement at %L",
640 symbol
->name
, &lvalue
->where
);
644 expr
= gfc_copy_expr (rvalue
);
645 if (!gfc_compare_types (&lvalue
->ts
, &expr
->ts
))
646 gfc_convert_type (expr
, &lvalue
->ts
, 0);
649 if (IS_POINTER (symbol
)
650 && !gfc_check_pointer_assign (lvalue
, rvalue
, false, true))
653 if (last_con
== NULL
)
654 symbol
->value
= expr
;
656 last_con
->expr
= expr
;
662 gfc_free_expr (expr
);
668 /* Modify the index of array section and re-calculate the array offset. */
671 gfc_advance_section (mpz_t
*section_index
, gfc_array_ref
*ar
,
672 mpz_t
*offset_ret
, int *vector_offset
)
679 gfc_expr
*start
, *end
, *stride
, *elem
;
680 gfc_constructor_base base
;
682 for (i
= 0; i
< ar
->dimen
; i
++)
684 bool advance
= false;
686 switch (ar
->dimen_type
[i
])
689 /* Loop to advance the next index. */
696 stride
= gfc_copy_expr(ar
->stride
[i
]);
697 if(!gfc_simplify_expr(stride
, 1))
698 gfc_internal_error("Simplification error");
699 mpz_add (section_index
[i
], section_index
[i
],
700 stride
->value
.integer
);
701 if (mpz_cmp_si (stride
->value
.integer
, 0) >= 0)
705 gfc_free_expr(stride
);
709 mpz_add_ui (section_index
[i
], section_index
[i
], 1);
715 end
= gfc_copy_expr(ar
->end
[i
]);
716 if(!gfc_simplify_expr(end
, 1))
717 gfc_internal_error("Simplification error");
718 cmp
= mpz_cmp (section_index
[i
], end
->value
.integer
);
722 cmp
= mpz_cmp (section_index
[i
], ar
->as
->upper
[i
]->value
.integer
);
724 if ((cmp
> 0 && forwards
) || (cmp
< 0 && !forwards
))
726 /* Reset index to start, then loop to advance the next index. */
729 start
= gfc_copy_expr(ar
->start
[i
]);
730 if(!gfc_simplify_expr(start
, 1))
731 gfc_internal_error("Simplification error");
732 mpz_set (section_index
[i
], start
->value
.integer
);
733 gfc_free_expr(start
);
736 mpz_set (section_index
[i
], ar
->as
->lower
[i
]->value
.integer
);
743 base
= ar
->start
[i
]->value
.constructor
;
744 elem
= gfc_constructor_lookup_expr (base
, vector_offset
[i
]);
748 /* Reset to first vector element and advance the next index. */
749 vector_offset
[i
] = 0;
750 elem
= gfc_constructor_lookup_expr (base
, 0);
755 start
= gfc_copy_expr (elem
);
756 if (!gfc_simplify_expr (start
, 1))
757 gfc_internal_error ("Simplification error");
758 mpz_set (section_index
[i
], start
->value
.integer
);
759 gfc_free_expr (start
);
771 mpz_set_si (*offset_ret
, 0);
772 mpz_init_set_si (delta
, 1);
774 for (i
= 0; i
< ar
->dimen
; i
++)
776 mpz_sub (tmp
, section_index
[i
], ar
->as
->lower
[i
]->value
.integer
);
777 mpz_mul (tmp
, tmp
, delta
);
778 mpz_add (*offset_ret
, tmp
, *offset_ret
);
780 mpz_sub (tmp
, ar
->as
->upper
[i
]->value
.integer
,
781 ar
->as
->lower
[i
]->value
.integer
);
782 mpz_add_ui (tmp
, tmp
, 1);
783 mpz_mul (delta
, tmp
, delta
);
790 /* Rearrange a structure constructor so the elements are in the specified
791 order. Also insert NULL entries if necessary. */
794 formalize_structure_cons (gfc_expr
*expr
)
796 gfc_constructor_base base
= NULL
;
797 gfc_constructor
*cur
;
798 gfc_component
*order
;
800 /* Constructor is already formalized. */
801 cur
= gfc_constructor_first (expr
->value
.constructor
);
802 if (!cur
|| cur
->n
.component
== NULL
)
805 for (order
= expr
->ts
.u
.derived
->components
; order
; order
= order
->next
)
807 cur
= find_con_by_component (order
, expr
->value
.constructor
);
809 gfc_constructor_append_expr (&base
, cur
->expr
, &cur
->expr
->where
);
811 gfc_constructor_append_expr (&base
, NULL
, NULL
);
814 /* For all what it's worth, one would expect
815 gfc_constructor_free (expr->value.constructor);
816 here. However, if the constructor is actually free'd,
817 hell breaks loose in the testsuite?! */
819 expr
->value
.constructor
= base
;
823 /* Make sure an initialization expression is in normalized form, i.e., all
824 elements of the constructors are in the correct order. */
827 formalize_init_expr (gfc_expr
*expr
)
835 type
= expr
->expr_type
;
839 for (c
= gfc_constructor_first (expr
->value
.constructor
);
840 c
; c
= gfc_constructor_next (c
))
841 formalize_init_expr (c
->expr
);
846 formalize_structure_cons (expr
);
855 /* Resolve symbol's initial value after all data statement. */
858 gfc_formalize_init_value (gfc_symbol
*sym
)
860 formalize_init_expr (sym
->value
);
864 /* Get the integer value into RET_AS and SECTION from AS and AR, and return
868 gfc_get_section_index (gfc_array_ref
*ar
, mpz_t
*section_index
, mpz_t
*offset
,
874 gfc_expr
*start
, *elem
;
875 gfc_constructor_base base
;
877 mpz_set_si (*offset
, 0);
879 mpz_init_set_si (delta
, 1);
880 for (i
= 0; i
< ar
->dimen
; i
++)
882 mpz_init (section_index
[i
]);
883 switch (ar
->dimen_type
[i
])
891 vector_offset
[i
] = 0;
892 base
= ar
->start
[i
]->value
.constructor
;
893 elem
= gfc_constructor_lookup_expr (base
, vector_offset
[i
]);
902 start
= gfc_copy_expr (elem
);
903 if (!gfc_simplify_expr (start
, 1))
904 gfc_internal_error ("Simplification error");
905 mpz_sub (tmp
, start
->value
.integer
,
906 ar
->as
->lower
[i
]->value
.integer
);
907 mpz_mul (tmp
, tmp
, delta
);
908 mpz_add (*offset
, tmp
, *offset
);
909 mpz_set (section_index
[i
], start
->value
.integer
);
910 gfc_free_expr (start
);
913 /* Fallback for empty section or constructor. */
914 mpz_set (section_index
[i
], ar
->as
->lower
[i
]->value
.integer
);
916 mpz_sub (tmp
, ar
->as
->upper
[i
]->value
.integer
,
917 ar
->as
->lower
[i
]->value
.integer
);
918 mpz_add_ui (tmp
, tmp
, 1);
919 mpz_mul (delta
, tmp
, delta
);