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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257065 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 62 insertions, 27 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 55b087f22ee..bd12b5d12bf 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,20 @@
+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.
+
 2018-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/54613
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 8911752f168..bead09a386f 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -332,8 +332,8 @@ _gfortran_caf_failed_images (gfc_descriptor_t *array,
   int local_kind = kind != NULL ? *kind : 4;
 
   array->base_addr = NULL;
-  array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
-		  | (local_kind << GFC_DTYPE_SIZE_SHIFT));
+  array->dtype.type = BT_INTEGER;
+  array->dtype.elem_len = local_kind;
    /* Setting lower_bound higher then upper_bound is what the compiler does to
       indicate an empty array.  */
   array->dim[0].lower_bound = 0;
@@ -354,8 +354,8 @@ _gfortran_caf_stopped_images (gfc_descriptor_t *array,
   int local_kind = kind != NULL ? *kind : 4;
 
   array->base_addr = NULL;
-  array->dtype =  ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
-		   | (local_kind << GFC_DTYPE_SIZE_SHIFT));
+  array->dtype.type =  BT_INTEGER;
+  array->dtype.elem_len =  local_kind;
   /* Setting lower_bound higher then upper_bound is what the compiler does to
      indicate an empty array.  */
   array->dim[0].lower_bound = 0;
diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c
index 290781889d0..08a7412ba97 100644
--- a/libgfortran/intrinsics/associated.c
+++ b/libgfortran/intrinsics/associated.c
@@ -37,7 +37,9 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target)
     return 0;
   if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target))
     return 0;
-  if (GFC_DESCRIPTOR_DTYPE (pointer) != GFC_DESCRIPTOR_DTYPE (target))
+  if (GFC_DESCRIPTOR_DTYPE (pointer).elem_len != GFC_DESCRIPTOR_DTYPE (target).elem_len)
+    return 0;
+  if (GFC_DESCRIPTOR_DTYPE (pointer).type != GFC_DESCRIPTOR_DTYPE (target).type)
     return 0;
 
   rank = GFC_DESCRIPTOR_RANK (pointer);
diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
index 7e288ef7c5e..a493b448b6a 100644
--- a/libgfortran/intrinsics/date_and_time.c
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -270,10 +270,9 @@ secnds (GFC_REAL_4 *x)
   /* Make the INTEGER*4 array for passing to date_and_time.  */
   gfc_array_i4 *avalues = xmalloc (sizeof (gfc_array_i4));
   avalues->base_addr = &values[0];
-  GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT)
-				        & GFC_DTYPE_TYPE_MASK) +
-				    (4 << GFC_DTYPE_SIZE_SHIFT);
-
+  GFC_DESCRIPTOR_DTYPE (avalues).type = BT_REAL;
+  GFC_DESCRIPTOR_DTYPE (avalues).elem_len = 4;
+  GFC_DESCRIPTOR_DTYPE (avalues).rank = 1;
   GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1);
 
   date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 7e076de84fa..8bc828c0214 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);
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 4c643b7e17b..80580a91082 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -327,14 +327,23 @@ typedef struct descriptor_dimension
   index_type lower_bound;
   index_type _ubound;
 }
-
 descriptor_dimension;
 
+typedef struct dtype_type
+{
+  size_t elem_len;
+  int version;
+  signed char rank;
+  signed char type;
+  signed short attribute;
+}
+dtype_type;
+
 #define GFC_ARRAY_DESCRIPTOR(r, type) \
 struct {\
   type *base_addr;\
   size_t offset;\
-  index_type dtype;\
+  dtype_type dtype;\
   index_type span;\
   descriptor_dimension dim[r];\
 }
@@ -375,10 +384,9 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
 typedef gfc_array_i1 gfc_array_s1;
 typedef gfc_array_i4 gfc_array_s4;
 
-#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
-#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
-                                   >> GFC_DTYPE_TYPE_SHIFT)
-#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
+#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank)
+#define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type)
+#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len)
 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
 
@@ -411,18 +419,24 @@ typedef gfc_array_i4 gfc_array_s4;
 #define GFC_DTYPE_SIZE_MASK (-((index_type) 1 << GFC_DTYPE_SIZE_SHIFT))
 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
 
-#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
+#define GFC_DTYPE_TYPE_SIZE(desc) (( ((desc)->dtype.type << GFC_DTYPE_TYPE_SHIFT) \
+    | ((desc)->dtype.elem_len << GFC_DTYPE_SIZE_SHIFT) ) & GFC_DTYPE_TYPE_SIZE_MASK)
 
 /* Macros to set size and type information.  */
 
 #define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0)
 #define GFC_DTYPE_COPY_SETRANK(a,b,n) \
   do { \
-  (a)->dtype = (((b)->dtype & ~GFC_DTYPE_RANK_MASK) | n ); \
+  (a)->dtype.rank = ((b)->dtype.rank | n ); \
   } while (0)
 
-#define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype == 0))
-#define GFC_DTYPE_CLEAR(a) do { (a)->dtype = 0; } while(0)
+#define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0))
+#define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \
+				(a)->dtype.version = 0; \
+				(a)->dtype.rank = 0; \
+				(a)->dtype.type = 0; \
+				(a)->dtype.attribute = 0; \
+} while(0)
 
 #define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
    | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))