aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog43
-rw-r--r--gcc/fortran/array.c5
-rw-r--r--gcc/fortran/libgfortran.h14
-rw-r--r--gcc/fortran/trans-array.c14
-rw-r--r--gcc/fortran/trans-expr.c14
-rw-r--r--gcc/fortran/trans-intrinsic.c14
-rw-r--r--gcc/fortran/trans-io.c9
-rw-r--r--gcc/fortran/trans-types.c125
-rw-r--r--gcc/fortran/trans-types.h1
-rw-r--r--gcc/fortran/trans.h6
-rw-r--r--gcc/testsuite/ChangeLog10
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_18.f9025
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f902
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_lib_token_4.f904
-rw-r--r--gcc/testsuite/gfortran.dg/inline_sum_1.f902
-rw-r--r--gcc/testsuite/gfortran.dg/rank_1.f905
16 files changed, 210 insertions, 83 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c477e96..d96ce8e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,46 @@
+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-23-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/83866
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 93deb0d..caa0b7f 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -197,6 +197,11 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
}
}
+ if (ar->dimen >= 7
+ && !gfc_notify_std (GFC_STD_F2008,
+ "Array reference at %C has more than 7 dimensions"))
+ return MATCH_ERROR;
+
gfc_error ("Array reference at %C cannot have more than %d dimensions",
GFC_MAX_DIMENSIONS);
return MATCH_ERROR;
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 2794635..b7954a9 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -150,15 +150,13 @@ typedef enum
#define GFC_STDOUT_UNIT_NUMBER 6
#define GFC_STDERR_UNIT_NUMBER 0
+/* F2003 onward. For std < F2003, error caught in array.c(gfc_match_array_ref). */
+#define GFC_MAX_DIMENSIONS 15
-/* FIXME: Increase to 15 for Fortran 2008. Also needs changes to
- GFC_DTYPE_RANK_MASK. See PR 36825. */
-#define GFC_MAX_DIMENSIONS 7
-
-#define GFC_DTYPE_RANK_MASK 0x07
-#define GFC_DTYPE_TYPE_SHIFT 3
-#define GFC_DTYPE_TYPE_MASK 0x38
-#define GFC_DTYPE_SIZE_SHIFT 6
+#define GFC_DTYPE_RANK_MASK 0x0F
+#define GFC_DTYPE_TYPE_SHIFT 4
+#define GFC_DTYPE_TYPE_MASK 0x70
+#define GFC_DTYPE_SIZE_SHIFT 7
/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
can take any arg with the pointer attribute as a param. These are also
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0cf1831..c16b875 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -239,7 +239,8 @@ gfc_conv_descriptor_dtype (tree desc)
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
- gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+ gcc_assert (field != NULL_TREE
+ && TREE_TYPE (field) == get_dtype_type_node ());
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
@@ -283,10 +284,11 @@ gfc_conv_descriptor_rank (tree desc)
tree dtype;
dtype = gfc_conv_descriptor_dtype (desc);
- tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
- tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
- dtype, tmp);
- return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
+ gcc_assert (tmp!= NULL_TREE
+ && TREE_TYPE (tmp) == signed_char_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
}
@@ -8205,7 +8207,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
else
{
/* Set the rank or unitialized memory access may be reported. */
- tmp = gfc_conv_descriptor_dtype (dest);
+ tmp = gfc_conv_descriptor_rank (dest);
gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank));
if (rank)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e90036f..f03aa18 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -66,9 +66,10 @@ get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
- tree desc, type;
+ tree desc, type, etype;
type = get_scalar_to_descriptor_type (scalar, attr);
+ etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -81,8 +82,10 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
}
if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
scalar = gfc_build_addr_expr (NULL_TREE, scalar);
+ else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+ etype = TREE_TYPE (etype);
gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
- gfc_get_dtype (type));
+ gfc_get_dtype_rank_type (0, etype));
gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
/* Copy pointer address back - but only if it could have changed and
@@ -5323,7 +5326,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
tmp = parmse.expr;
if (TREE_CODE (tmp) == ADDR_EXPR
- && POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0))))
+ && (POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0)))
+ || e->expr_type == EXPR_CONSTANT))
tmp = TREE_OPERAND (tmp, 0);
parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp,
fsym->attr);
@@ -7611,8 +7615,8 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
rank = 1;
size = integer_zero_node;
desc = field;
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
- build_int_cst (gfc_array_index_type, rank));
+ gfc_add_modify (&block, gfc_conv_descriptor_rank (desc),
+ build_int_cst (signed_char_type_node, rank));
}
else
{
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index f4defb0..af647c4 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2602,6 +2602,8 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
gfc_add_block_to_block (&se->post, &argse.post);
se->expr = gfc_conv_descriptor_rank (argse.expr);
+ se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
+ se->expr);
}
@@ -6783,6 +6785,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
tree lower;
tree upper;
tree byte_size;
+ tree field;
int n;
gfc_init_se (&argse, NULL);
@@ -6805,10 +6808,13 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
? GFC_DECL_SAVED_DESCRIPTOR (tmp) : tmp;
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = fold_convert (size_type_node, gfc_conv_descriptor_dtype (tmp));
- tmp = fold_build2_loc (input_location, RSHIFT_EXPR, TREE_TYPE (tmp), tmp,
- build_int_cst (TREE_TYPE (tmp),
- GFC_DTYPE_SIZE_SHIFT));
+
+ tmp = gfc_conv_descriptor_dtype (tmp);
+ field = gfc_advance_chain (TYPE_FIELDS (get_dtype_type_node ()),
+ GFC_DTYPE_ELEM_LEN);
+ tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+ tmp, field, NULL_TREE);
+
byte_size = fold_convert (gfc_array_index_type, tmp);
}
else if (arg->ts.type == BT_CLASS)
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 082b9f7..021c788 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -478,12 +478,12 @@ gfc_build_io_library_fndecls (void)
iocall[IOCALL_SET_NML_VAL] = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("st_set_nml_var")), ".w.R",
void_type_node, 6, dt_parm_type, pvoid_type_node, pvoid_type_node,
- gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node);
+ gfc_int4_type_node, gfc_charlen_type_node, get_dtype_type_node());
iocall[IOCALL_SET_NML_DTIO_VAL] = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("st_set_nml_dtio_var")), ".w.R",
void_type_node, 8, dt_parm_type, pvoid_type_node, pvoid_type_node,
- gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node,
+ gfc_int4_type_node, gfc_charlen_type_node, get_dtype_type_node(),
pvoid_type_node, pvoid_type_node);
iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec (
@@ -1662,7 +1662,6 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
tree dtio_proc = null_pointer_node;
tree vtable = null_pointer_node;
int n_dim;
- int itype;
int rank = 0;
gcc_assert (sym || c);
@@ -1699,8 +1698,8 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
}
else
{
- itype = ts->type;
- dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
+ dt = gfc_typenode_for_spec (ts);
+ dtype = gfc_get_dtype_rank_type (0, dt);
}
/* Build up the arguments for the transfer call.
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index abcbf95..fd25ce5 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -130,6 +130,47 @@ int gfc_size_kind;
int gfc_numeric_storage_size;
int gfc_character_storage_size;
+tree dtype_type_node = NULL_TREE;
+
+
+/* Build the dtype_type_node if necessary. */
+tree get_dtype_type_node (void)
+{
+ tree field;
+ tree dtype_node;
+ tree *dtype_chain = NULL;
+
+ if (dtype_type_node == NULL_TREE)
+ {
+ dtype_node = make_node (RECORD_TYPE);
+ TYPE_NAME (dtype_node) = get_identifier ("dtype_type");
+ TYPE_NAMELESS (dtype_node) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("elem_len"),
+ size_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("version"),
+ integer_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("rank"),
+ signed_char_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("type"),
+ signed_char_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("attribute"),
+ short_integer_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ gfc_finish_type (dtype_node);
+ TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node)) = 1;
+ dtype_type_node = dtype_node;
+ }
+ return dtype_type_node;
+}
bool
gfc_check_any_c_kind (gfc_typespec *ts)
@@ -1003,7 +1044,7 @@ gfc_init_types (void)
by the number of bits available to store this field in the array
descriptor. */
- n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
+ n = TYPE_PRECISION (size_type_node);
gfc_max_array_element_size
= wide_int_to_tree (size_type_node,
wi::mask (n, UNSIGNED,
@@ -1255,12 +1296,21 @@ gfc_get_element_type (tree type)
struct gfc_array_descriptor
{
- array *data
+ array *data;
index offset;
- index dtype;
+ struct dtype_type dtype;
struct descriptor_dimension dimension[N_DIM];
}
+ struct dtype_type
+ {
+ size_t elem_len;
+ int version;
+ signed char rank;
+ signed char type;
+ signed short attribute;
+ }
+
struct descriptor_dimension
{
index stride;
@@ -1277,11 +1327,6 @@ gfc_get_element_type (tree type)
are gfc_array_index_type and the data node is a pointer to the
data. See below for the handling of character types.
- The dtype member is formatted as follows:
- rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
- type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
- size = dtype >> GFC_DTYPE_SIZE_SHIFT
-
I originally used nested ARRAY_TYPE nodes to represent arrays, but
this generated poor code for assumed/deferred size arrays. These
require use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part
@@ -1468,9 +1513,10 @@ gfc_get_dtype_rank_type (int rank, tree etype)
{
tree size;
int n;
- HOST_WIDE_INT i;
tree tmp;
tree dtype;
+ tree field;
+ vec<constructor_elt, va_gc> *v = NULL;
switch (TREE_CODE (etype))
{
@@ -1490,18 +1536,21 @@ gfc_get_dtype_rank_type (int rank, tree etype)
n = BT_COMPLEX;
break;
- /* We will never have arrays of arrays. */
case RECORD_TYPE:
- n = BT_DERIVED;
+ if (GFC_CLASS_TYPE_P (etype))
+ n = BT_CLASS;
+ else
+ n = BT_DERIVED;
break;
+ /* We will never have arrays of arrays. */
case ARRAY_TYPE:
n = BT_CHARACTER;
break;
case POINTER_TYPE:
n = BT_ASSUMED;
- break;
+ break;
default:
/* TODO: Don't do dtype for temporary descriptorless arrays. */
@@ -1509,32 +1558,27 @@ gfc_get_dtype_rank_type (int rank, tree etype)
return gfc_index_zero_node;
}
- gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
size = TYPE_SIZE_UNIT (etype);
+ if (n == BT_CHARACTER && size == NULL_TREE)
+ size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
- i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
- if (size && INTEGER_CST_P (size))
- {
- if (tree_int_cst_lt (gfc_max_array_element_size, size))
- gfc_fatal_error ("Array element size too big at %C");
+ tmp = get_dtype_type_node ();
+ field = gfc_advance_chain (TYPE_FIELDS (tmp),
+ GFC_DTYPE_ELEM_LEN);
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ fold_convert (TREE_TYPE (field), size));
- i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
- }
- dtype = build_int_cst (gfc_array_index_type, i);
+ field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+ GFC_DTYPE_RANK);
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ build_int_cst (TREE_TYPE (field), rank));
- if (size && !INTEGER_CST_P (size))
- {
- tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT);
- tmp = fold_build2_loc (input_location, LSHIFT_EXPR,
- gfc_array_index_type,
- fold_convert (gfc_array_index_type, size), tmp);
- dtype = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- tmp, dtype);
- }
- /* If we don't know the size we leave it as zero. This should never happen
- for anything that is actually used. */
- /* TODO: Check this is actually true, particularly when repacking
- assumed size parameters. */
+ field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+ GFC_DTYPE_TYPE);
+ CONSTRUCTOR_APPEND_ELT (v, field,
+ build_int_cst (TREE_TYPE (field), n));
+
+ dtype = build_constructor (tmp, v);
return dtype;
}
@@ -1820,7 +1864,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
/* Add the dtype component. */
decl = gfc_add_field_to_struct_1 (fat_type,
get_identifier ("dtype"),
- gfc_array_index_type, &chain);
+ get_dtype_type_node (), &chain);
TREE_NO_WARNING (decl) = 1;
/* Add the span component. */
@@ -3232,6 +3276,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
tree etype, ptype, t, base_decl;
tree data_off, dim_off, dtype_off, dim_size, elem_size;
tree lower_suboff, upper_suboff, stride_suboff;
+ tree dtype, field, rank_off;
if (! GFC_DESCRIPTOR_TYPE_P (type))
{
@@ -3313,11 +3358,15 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
t = base_decl;
if (!integer_zerop (dtype_off))
t = fold_build_pointer_plus (t, dtype_off);
+ dtype = TYPE_MAIN_VARIANT (get_dtype_type_node ());
+ field = gfc_advance_chain (TYPE_FIELDS (dtype), GFC_DTYPE_RANK);
+ rank_off = byte_position (field);
+ if (!integer_zerop (dtype_off))
+ t = fold_build_pointer_plus (t, rank_off);
+
t = build1 (NOP_EXPR, build_pointer_type (gfc_array_index_type), t);
t = build1 (INDIRECT_REF, gfc_array_index_type, t);
- info->rank = build2 (BIT_AND_EXPR, gfc_array_index_type, t,
- build_int_cst (gfc_array_index_type,
- GFC_DTYPE_RANK_MASK));
+ info->rank = t;
t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off));
t = size_binop (MULT_EXPR, t, dim_size);
dim_off = build2 (PLUS_EXPR, TREE_TYPE (dim_off), t, dim_off);
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 99798ab..197b173 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -73,6 +73,7 @@ void gfc_init_kinds (void);
void gfc_init_types (void);
void gfc_init_c_interop_kinds (void);
+tree get_dtype_type_node (void);
tree gfc_get_int_type (int);
tree gfc_get_real_type (int);
tree gfc_get_complex_type (int);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 31b0930..35e1bd2 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -914,6 +914,12 @@ extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
/* gfortran-specific declaration information, the _CONT versions denote
arrays with CONTIGUOUS attribute. */
+#define GFC_DTYPE_ELEM_LEN 0
+#define GFC_DTYPE_VERSION 1
+#define GFC_DTYPE_RANK 2
+#define GFC_DTYPE_TYPE 3
+#define GFC_DTYPE_ATTRIBUTE 4
+
enum gfc_array_kind
{
GFC_ARRAY_UNKNOWN,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1a62d91..ff91f1e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+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-01-25 Jan Hubicka <hubicka@ucw.cz>
PR middle-end/83055
diff --git a/gcc/testsuite/gfortran.dg/coarray_18.f90 b/gcc/testsuite/gfortran.dg/coarray_18.f90
index 474e939..1e80df9 100644
--- a/gcc/testsuite/gfortran.dg/coarray_18.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_18.f90
@@ -5,8 +5,7 @@
! dimensions (normal + codimensions).
!
! Fortran 2008 allows (co)arrays with 15 ranks
-! Currently, gfortran only supports 7, cf. PR 37577
-! Thus, the program is valid Fortran 2008 ...
+! Previously gfortran only supported 7, cf. PR 37577
!
! See also general coarray PR 18918
!
@@ -19,14 +18,20 @@ program ar
integer :: ic(2)[*]
integer :: id(2,2)[2,*]
integer :: ie(2,2,2)[2,2,*]
- integer :: ig(2,2,2,2)[2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: ih(2,2,2,2,2)[2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: ij(2,2,2,2,2,2)[2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: ik(2,2,2,2,2,2,2)[2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: il[2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: im[2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: in[2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
- integer :: io[2,2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
+! Previously, these would give errors.
+ integer :: ig(2,2,2,2)[2,2,2,*]
+ integer :: ih(2,2,2,2,2)[2,2,2,2,*]
+ integer :: ij(2,2,2,2,2,2)[2,2,2,2,2,*]
+ integer :: ik(2,2,2,2,2,2,2)[2,2,2,2,2,2,*]
+ integer :: il[2,2,2,2,2,2,2,*]
+ integer :: im[2,2,2,2,2,2,2,2,*]
+ integer :: in[2,2,2,2,2,2,2,2,2,*]
+ integer :: io[2,2,2,2,2,2,2,2,2,2,*]
+! Now with max dimensions 15.....
+ integer :: ip(2,2,2,2,2,2,2,2)[2,2,2,2,2,2,2,*] ! { dg-error "has more than 15 dimensions" }
+ integer :: iq[2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 15 dimensions" }
+! Check a non-coarray
+ integer :: ir(2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2) ! { dg-error "has more than 15 dimensions" }
real :: x2(2,2,4)[2,*]
complex :: c2(4,2)[2,*]
double precision :: d2(1,5,9)[2,*]
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
index 196a2d3..7b44c73 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
@@ -16,7 +16,7 @@ contains
end subroutine bar
end
-! { dg-final { scan-tree-dump-times "bar \\(struct array1_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct array01_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
index 8183140..b09552a 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
@@ -35,9 +35,9 @@ end program test_caf
! { dg-final { scan-tree-dump-times "expl \\(integer\\(kind=4\\).0:. . restrict z, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
-! { dg-final { scan-tree-dump-times "bar \\(struct array1_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct array01_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
-! { dg-final { scan-tree-dump-times "foo \\(struct array1_integer\\(kind=4\\) & restrict x, struct array1_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(struct array01_integer\\(kind=4\\) & restrict x, struct array01_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } }
!
diff --git a/gcc/testsuite/gfortran.dg/inline_sum_1.f90 b/gcc/testsuite/gfortran.dg/inline_sum_1.f90
index a9d4f7b..bff01bc 100644
--- a/gcc/testsuite/gfortran.dg/inline_sum_1.f90
+++ b/gcc/testsuite/gfortran.dg/inline_sum_1.f90
@@ -188,6 +188,6 @@ contains
o = i
end subroutine tes
end
-! { dg-final { scan-tree-dump-times "struct array._integer\\(kind=4\\) atmp" 13 "original" } }
+! { dg-final { scan-tree-dump-times "struct array.._integer\\(kind=4\\) atmp" 13 "original" } }
! { dg-final { scan-tree-dump-times "struct array\[^\\n\]*atmp" 13 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/rank_1.f90 b/gcc/testsuite/gfortran.dg/rank_1.f90
index 6a81e410..3467fad 100644
--- a/gcc/testsuite/gfortran.dg/rank_1.f90
+++ b/gcc/testsuite/gfortran.dg/rank_1.f90
@@ -4,7 +4,6 @@
! Fortran < 2008 allows 7 dimensions
! Fortran 2008 allows 15 dimensions (including co-array ranks)
!
-! FIXME: Rank patch was reverted because of PR 36825.
-integer :: a(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ! { dg-error "has more than 7 dimensions" }
-integer :: b(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16) ! { dg-error "has more than 7 dimensions" }
+integer :: a(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
+integer :: b(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16) ! { dg-error "has more than 15 dimensions" }
end
generated by cgit v1.1 at 2025-04-24 17:58:56 +0000