summaryrefslogtreecommitdiff
path: root/libgfortran/m4/iforeach.m4
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/m4/iforeach.m4')
-rw-r--r--libgfortran/m4/iforeach.m470
1 files changed, 9 insertions, 61 deletions
diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4
index 0960d22aeb4..d86d298a3af 100644
--- a/libgfortran/m4/iforeach.m4
+++ b/libgfortran/m4/iforeach.m4
@@ -35,21 +35,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in u_name intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " u_name intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@@ -150,38 +137,11 @@ void
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in u_name intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " u_name intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in u_name intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " u_name intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "u_name");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "u_name");
}
}
@@ -303,22 +263,10 @@ void
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in u_name intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);