aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2018-01-25 19:09:40 +0000
committerPaul Thomas <pault@gcc.gnu.org>2018-01-25 19:09:40 +0000
commit7fb43006b28405ebf5309223e9d769b74008003e (patch)
tree45de92d7d82dec6371a4d9bcbfb4845426c74cba /libgfortran/io
parent09cf48c9de850797570dfafa6fa70d4caf9d6862 (diff)
downloadgcc-7fb43006b28405ebf5309223e9d769b74008003e.zip
gcc-7fb43006b28405ebf5309223e9d769b74008003e.tar.gz
gcc-7fb43006b28405ebf5309223e9d769b74008003e.tar.bz2
re PR fortran/37577 ([meta-bug] change internal array descriptor format for better syntax, C interop TR, rank 15)
2018-25-01 Paul Thomas <pault@gcc.gnu.org> PR fortran/37577 * array.c (gfc_match_array_ref): If standard earlier than F2008 it is an error if the reference dimension is greater than 7. libgfortran.h : Increase GFC_MAX_DIMENSIONS to 15. Change the dtype masks and shifts accordingly. * trans-array.c (gfc_conv_descriptor_dtype): Use the dtype type node to check the field. (gfc_conv_descriptor_dtype): Access the rank field of dtype. (duplicate_allocatable_coarray): Access the rank field of the dtype descriptor rather than the dtype itself. * trans-expr.c (get_scalar_to_descriptor_type): Store the type of 'scalar' on entry and use its TREE_TYPE if it is ARRAY_TYPE (ie. a character). (gfc_conv_procedure_call): Pass TREE_OPERAND (tmp,0) to get_scalar_to_descriptor_type if the actual expression is a constant. (gfc_trans_structure_assign): Assign the rank directly to the dtype rank field. * trans-intrinsic.c (gfc_conv_intrinsic_rank): Cast the result to default integer kind. (gfc_conv_intrinsic_sizeof): Obtain the element size from the 'elem_len' field of the dtype. * trans-io.c (gfc_build_io_library_fndecls): Replace gfc_int4_type_node with dtype_type_node where necessary. (transfer_namelist_element): Use gfc_get_dtype_rank_type for scalars. * trans-types.c : Provide 'get_dtype_type_node' to acces the dtype_type_node and, if necessary, build it. The maximum size of an array element is now determined by the maximum value of size_t. Update the description of the array descriptor, including the type def for the dtype_type. (gfc_get_dtype_rank_type): Build a constructor for the dtype. Distinguish RECORD_TYPEs that are BT_DERIVED or BT_CLASS. (gfc_get_array_descriptor_base): Change the type of the dtype field to dtype_type_node. (gfc_get_array_descr_info): Get the offset to the rank field of the dtype. * trans-types.h : Add a prototype for 'get_dtype_type_node ()'. * trans.h : Define the indices of the dtype fields. 2018-25-01 Paul Thomas <pault@gcc.gnu.org> PR fortran/37577 * gfortran.dg/coarray_18.f90: Allow dimension 15 for F2008. * gfortran.dg/coarray_lib_this_image_2.f90: Change 'array1' to 'array01' in the tree dump comparison. * gfortran.dg/coarray_lib_token_4.f90: Likewise. * gfortran.dg/inline_sum_1.f90: Similar - allow two digits. * gfortran.dg/rank_1.f90: Allow dimension 15 for F2008. 2018-25-01 Paul Thomas <pault@gcc.gnu.org> PR fortran/37577 * caf/single.c (_gfortran_caf_failed_images): Access the 'type' and 'elem_len' fields of the dtype instead of the shifts. (_gfortran_caf_stopped_images): Likewise. * intrinsics/associated.c (associated): Compare the 'type' and 'elem_len' fields instead of the dtype. * caf/date_and_time.c : Access the dtype fields rather using shifts and masks. * io/transfer.c (transfer_array ): Comment on item count. (set_nml_var,st_set_nml_var): Change dtype type and use fields. (st_set_nml_dtio_var): Likewise. * libgfortran.h : Change definition of GFC_ARRAY_DESCRIPTOR and add a typedef for the dtype_type. Change the GFC_DTYPE_* macros to access the dtype fields. From-SVN: r257065
Diffstat (limited to 'libgfortran/io')
-rw-r--r--libgfortran/io/transfer.c19
1 files changed, 11 insertions, 8 deletions
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 7e076de..8bc828c 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2406,6 +2406,8 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
char *data;
bt iotype;
+ /* Adjust item_count before emitting error message. */
+
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
return;
@@ -2413,6 +2415,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
size = iotype == BT_CHARACTER ? (index_type) charlen : GFC_DESCRIPTOR_SIZE (desc);
rank = GFC_DESCRIPTOR_RANK (desc);
+
for (n = 0; n < rank; n++)
{
count[n] = 0;
@@ -4208,7 +4211,7 @@ st_wait (st_parameter_wait *wtp __attribute__((unused)))
static void
set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
GFC_INTEGER_4 len, gfc_charlen_type string_length,
- GFC_INTEGER_4 dtype, void *dtio_sub, void *vtable)
+ dtype_type dtype, void *dtio_sub, void *vtable)
{
namelist_info *t1 = NULL;
namelist_info *nml;
@@ -4227,9 +4230,9 @@ set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
nml->len = (int) len;
nml->string_length = (index_type) string_length;
- nml->var_rank = (int) (dtype & GFC_DTYPE_RANK_MASK);
- nml->size = (index_type) (dtype >> GFC_DTYPE_SIZE_SHIFT);
- nml->type = (bt) ((dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT);
+ nml->var_rank = (int) (dtype.rank);
+ nml->size = (index_type) (dtype.elem_len);
+ nml->type = (bt) (dtype.type);
if (nml->var_rank > 0)
{
@@ -4259,13 +4262,13 @@ set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
}
extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *,
- GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4);
+ GFC_INTEGER_4, gfc_charlen_type, dtype_type);
export_proto(st_set_nml_var);
void
st_set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
GFC_INTEGER_4 len, gfc_charlen_type string_length,
- GFC_INTEGER_4 dtype)
+ dtype_type dtype)
{
set_nml_var (dtp, var_addr, var_name, len, string_length,
dtype, NULL, NULL);
@@ -4275,7 +4278,7 @@ st_set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
/* Essentially the same as previous but carrying the dtio procedure
and the vtable as additional arguments. */
extern void st_set_nml_dtio_var (st_parameter_dt *dtp, void *, char *,
- GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4,
+ GFC_INTEGER_4, gfc_charlen_type, dtype_type,
void *, void *);
export_proto(st_set_nml_dtio_var);
@@ -4283,7 +4286,7 @@ export_proto(st_set_nml_dtio_var);
void
st_set_nml_dtio_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
GFC_INTEGER_4 len, gfc_charlen_type string_length,
- GFC_INTEGER_4 dtype, void *dtio_sub, void *vtable)
+ dtype_type dtype, void *dtio_sub, void *vtable)
{
set_nml_var (dtp, var_addr, var_name, len, string_length,
dtype, dtio_sub, vtable);