aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog17
-rw-r--r--gcc/fortran/class.c18
-rw-r--r--gcc/fortran/module.c17
-rw-r--r--gcc/fortran/trans-array.c29
-rw-r--r--gcc/fortran/trans-stmt.c10
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/auto_dealloc_2.f902
-rw-r--r--gcc/testsuite/gfortran.dg/class_19.f032
8 files changed, 49 insertions, 52 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 326a01f..4ecf60b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,23 @@
2013-05-28 Tobias Burnus <burnus@net-b.de>
PR fortran/37336
+ * class.c (finalize_component): Fix coarray array refs.
+ (generate_finalization_wrapper): Only gfc_convert_type_warn
+ when the kind value is different.
+ (gfc_find_intrinsic_vtab): _copy's dst is now intent(inout).
+ (gfc_find_derived_vtab): Ditto. Enable finalization-wrapper
+ generation.
+ * module.c (MOD_VERSION): Bump.
+ (gfc_dump_module, gfc_use_module): Remove empty line in .mod.
+ * trans-array.c (gfc_conv_descriptor_token): Accept nonrestricted
+ void pointer.
+ (gfc_array_allocate, structure_alloc_comps): Don't nullify for
+ BT_CLASS allocations.
+ * trans-stmt.c (gfc_trans_allocate): Ditto.
+
+2013-05-28 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/37336
* resolve.c (gfc_resolve_finalizers): Remove not implemented error.
2013-05-28 Tobias Burnus <burnus@net-b.de>
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 349f494..ba8efa9 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -832,17 +832,18 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
ref->u.c.component = comp;
e->ts = comp->ts;
- if (comp->attr.dimension
+ if (comp->attr.dimension || comp->attr.codimension
|| (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
- && CLASS_DATA (comp)->attr.dimension))
+ && (CLASS_DATA (comp)->attr.dimension
+ || CLASS_DATA (comp)->attr.codimension)))
{
ref->next = gfc_get_ref ();
ref->next->type = REF_ARRAY;
- ref->next->u.ar.type = AR_FULL;
ref->next->u.ar.dimen = 0;
ref->next->u.ar.as = comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->as
: comp->as;
e->rank = ref->next->u.ar.as->rank;
+ ref->next->u.ar.type = e->rank ? AR_FULL : AR_ELEMENT;
}
/* Call DEALLOCATE (comp, stat=ignore). */
@@ -1640,7 +1641,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
rank = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_RANK, "rank",
gfc_current_locus, 1,
gfc_lval_expr_from_sym (array));
- gfc_convert_type (rank, &idx->ts, 2);
+ if (rank->ts.kind != idx->ts.kind)
+ gfc_convert_type_warn (rank, &idx->ts, 2, 0);
/* Create is_contiguous variable. */
gfc_get_symbol ("is_contiguous", sub_ns, &is_contiguous);
@@ -2363,7 +2365,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
dst->attr.flavor = FL_VARIABLE;
dst->attr.dummy = 1;
dst->attr.artificial = 1;
- dst->attr.intent = INTENT_OUT;
+ dst->attr.intent = INTENT_INOUT;
gfc_set_sym_referenced (dst);
copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst;
@@ -2382,9 +2384,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
components and the calls to finalization subroutines.
Note: The actual wrapper function can only be generated
at resolution time. */
- /* FIXME: Enable ABI-breaking "_final" generation. */
- if (0)
- {
if (!gfc_add_component (vtype, "_final", &c))
goto cleanup;
c->attr.proc_pointer = 1;
@@ -2392,7 +2391,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
generate_finalization_wrapper (derived, ns, tname, c);
- }
/* Add procedure pointers for type-bound procedures. */
if (!derived->attr.unlimited_polymorphic)
@@ -2651,7 +2649,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
dst->ts.kind = ts->kind;
dst->attr.flavor = FL_VARIABLE;
dst->attr.dummy = 1;
- dst->attr.intent = INTENT_OUT;
+ dst->attr.intent = INTENT_INOUT;
gfc_set_sym_referenced (dst);
copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index bc31671..c390a95 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -80,10 +80,8 @@ along with GCC; see the file COPYING3. If not see
#define MODULE_EXTENSION ".mod"
/* Don't put any single quote (') in MOD_VERSION, if you want it to be
- recognized.
- TODO: When the version is bumped, remove the extra empty line at
- the beginning of module files. */
-#define MOD_VERSION "10"
+ recognized. */
+#define MOD_VERSION "11"
/* Structure that describes a position within a module file. */
@@ -5567,14 +5565,9 @@ gfc_dump_module (const char *name, int dump_flag)
gfc_fatal_error ("Can't open module file '%s' for writing at %C: %s",
filename_tmp, xstrerror (errno));
- /* Write the header.
- FIXME: For backwards compatibility with the old uncompressed
- module format, write an extra empty line. When the module version
- is bumped, this can be removed. */
- gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n\n",
+ gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n",
MOD_VERSION, gfc_source_file);
-
/* Write the module itself. */
iomode = IO_OUTPUT;
module_name = gfc_get_string (name);
@@ -6364,10 +6357,10 @@ gfc_use_module (gfc_use_list *module)
read_module_to_tmpbuf ();
gzclose (module_fp);
- /* Skip the first two lines of the module, after checking that this is
+ /* Skip the first line of the module, after checking that this is
a gfortran module file. */
line = 0;
- while (line < 2)
+ while (line < 1)
{
c = module_char ();
if (c == EOF)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6cb85d4..be3a5a0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -300,7 +300,11 @@ gfc_conv_descriptor_token (tree desc)
gcc_assert (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE);
gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD);
- gcc_assert (field != NULL_TREE && TREE_TYPE (field) == prvoid_type_node);
+
+ /* Should be a restricted pointer - except in the finalization wrapper. */
+ gcc_assert (field != NULL_TREE
+ && (TREE_TYPE (field) == prvoid_type_node
+ || TREE_TYPE (field) == pvoid_type_node));
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
@@ -5222,18 +5226,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
gfc_add_expr_to_block (&se->pre, tmp);
- if (expr->ts.type == BT_CLASS)
- {
- tmp = build_int_cst (unsigned_char_type_node, 0);
- /* With class objects, it is best to play safe and null the
- memory because we cannot know if dynamic types have allocatable
- components or not. */
- tmp = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMSET),
- 3, pointer, tmp, size);
- gfc_add_expr_to_block (&se->pre, tmp);
- }
-
/* Update the array descriptors. */
if (dimension)
gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
@@ -7699,6 +7691,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
{
nelems = gfc_conv_descriptor_size (src_data,
CLASS_DATA (c)->as->rank);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ size_type_node, size,
+ fold_convert (size_type_node,
+ nelems));
src_data = gfc_conv_descriptor_data_get (src_data);
dst_data = gfc_conv_descriptor_data_get (dst_data);
}
@@ -7707,11 +7703,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
gfc_init_block (&tmpblock);
- /* We need to use CALLOC as _copy might try to free allocatable
- components of the destination. */
- ftn_tree = builtin_decl_explicit (BUILT_IN_CALLOC);
- tmp = build_call_expr_loc (input_location, ftn_tree, 2, nelems,
- size);
+ ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC);
+ tmp = build_call_expr_loc (input_location, ftn_tree, 1, size);
gfc_add_modify (&tmpblock, dst_data,
fold_convert (TREE_TYPE (dst_data), tmp));
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 058fd99a..7812934 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5071,16 +5071,6 @@ gfc_trans_allocate (gfc_code * code)
tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
}
- else if (al->expr->ts.type == BT_CLASS)
- {
- /* With class objects, it is best to play safe and null the
- memory because we cannot know if dynamic types have allocatable
- components or not. */
- tmp = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMSET),
- 3, se.expr, integer_zero_node, memsz);
- gfc_add_expr_to_block (&se.pre, tmp);
- }
}
gfc_add_block_to_block (&block, &se.pre);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 533abbb..3809f566 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2013-05-28 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/37336
+ * gfortran.dg/auto_dealloc_2.f90: Update _free count in the dump.
+ * gfortran.dg/class_19.f03: Ditto.
+
2013-05-29 Richard Biener <rguenther@suse.de>
* gcc.dg/vect/bb-slp-32.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
index e607b6a..d261973 100644
--- a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
+++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
@@ -25,5 +25,5 @@ contains
end program
-! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/class_19.f03 b/gcc/testsuite/gfortran.dg/class_19.f03
index 63b8e06..6dcd99c 100644
--- a/gcc/testsuite/gfortran.dg/class_19.f03
+++ b/gcc/testsuite/gfortran.dg/class_19.f03
@@ -39,5 +39,5 @@ program main
end program main
-! { dg-final { scan-tree-dump-times "__builtin_free" 11 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 15 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
generated by cgit v1.1 at 2025-05-01 01:41:53 +0000