https://gcc.gnu.org/g:6ae3ab6fb31323a6009cc3884c4eca94a913144d
commit 6ae3ab6fb31323a6009cc3884c4eca94a913144d Author: Jerry D <[email protected]> Date: Sat Aug 8 12:31:38 2026 -0700 fortran: [PR53800] Wrong copy-in/out with array actual to, TARGET dummy See the attached patch. This is several iterations after Mikael's comments which were very helpful. I took a different approach on the use of macros and this addresses the non derived type examples Mikael provided in the previous review. I have added additional test cases. Regression tested on x86_64. OK for mainline? Regards, Jerry Diff: --- gcc/fortran/trans-array.cc | 55 +++++++++- gcc/fortran/trans-decl.cc | 24 +++- gcc/fortran/trans-expr.cc | 36 ++++-- gcc/fortran/trans.cc | 30 ++++- gcc/fortran/trans.h | 3 + gcc/testsuite/gfortran.dg/c_loc_test_22.f90 | 6 +- gcc/testsuite/gfortran.dg/class_to_type_5.f90 | 35 ++++++ gcc/testsuite/gfortran.dg/class_to_type_6.f90 | 93 ++++++++++++++++ gcc/testsuite/gfortran.dg/class_to_type_7.f90 | 151 ++++++++++++++++++++++++++ 9 files changed, 411 insertions(+), 22 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 91fa43b26831..3d3a373bf04a 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -458,7 +458,8 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) } -/* Returns true if the expression is an array pointer. */ +/* Returns true if the expression is an array pointer. The tree must be a + descriptor. */ static bool is_pointer_array (tree expr) @@ -480,7 +481,7 @@ is_pointer_array (tree expr) && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 0))) return true; - /* The field declaration is marked as an pointer array. */ + /* The field declaration is marked as a pointer array. */ if (TREE_CODE (expr) == COMPONENT_REF && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 1)) && !GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (expr, 1)))) @@ -490,6 +491,23 @@ is_pointer_array (tree expr) } +/* If EXPR is a decl flagged as a pointer array but has no descriptor of its + own, return the saved descriptor that holds its span, + otherwise NULL_TREE. */ + +static tree +saved_desc_pointer_array (tree expr) +{ + if (VAR_P (expr) + && GFC_DECL_PTR_ARRAY_P (expr) + && GFC_ARRAY_TYPE_P (TREE_TYPE (expr)) + && DECL_LANG_SPECIFIC (expr)) + return GFC_DECL_SAVED_DESCRIPTOR (expr); + + return NULL_TREE; +} + + /* If the symbol or expression reference a CFI descriptor, return the pointer to the converted gfc descriptor. If an array reference is present as the last argument, check that it is the one applied to @@ -553,6 +571,8 @@ gfc_get_array_span (tree desc, gfc_expr *expr) tree tmp; gfc_symbol *sym = (expr && expr->expr_type == EXPR_VARIABLE) ? expr->symtree->n.sym : NULL; + tree span_desc = (sym && sym->backend_decl) + ? saved_desc_pointer_array (sym->backend_decl) : NULL_TREE; if (is_pointer_array (desc) || (get_CFI_desc (NULL, expr, &desc, NULL) @@ -560,11 +580,8 @@ gfc_get_array_span (tree desc, gfc_expr *expr) ? GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (desc))) : GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))))) { - if (POINTER_TYPE_P (TREE_TYPE (desc))) - desc = build_fold_indirect_ref_loc (input_location, desc); - /* This will have the span field set. */ - tmp = gfc_conv_descriptor_span_get (desc); + tmp = gfc_conv_descriptor_span_get (gfc_get_span_descriptor (desc)); } else if (expr->ts.type == BT_ASSUMED) { @@ -588,6 +605,25 @@ gfc_get_array_span (tree desc, gfc_expr *expr) /* Having escaped the above, this can only be a class array dummy. */ tmp = class_array_element_size (sym->backend_decl, UNLIMITED_POLY (sym)); + else if (span_desc + && (expr->ref == NULL + || (expr->ref->type == REF_ARRAY && expr->ref->next == NULL))) + { + /* A descriptorless dummy re-passed to another procedure. Read its + span from the saved descriptor. */ + if (POINTER_TYPE_P (TREE_TYPE (span_desc))) + span_desc = build_fold_indirect_ref_loc (input_location, span_desc); + tmp = gfc_conv_descriptor_span_get (span_desc); + + /* An absent optional dummy has no valid saved descriptor to read; + avoid trying to use it and fall back to the static element size. */ + if (sym->attr.dummy && sym->attr.optional) + tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), + gfc_conv_expr_present (sym), tmp, + fold_convert (TREE_TYPE (tmp), + TYPE_SIZE_UNIT ( + gfc_get_element_type (TREE_TYPE (desc))))); + } else { /* If none of the fancy stuff works, the span is the element @@ -4050,6 +4086,9 @@ build_array_ref (tree desc, tree offset, tree decl, tree vptr) } } + if (decl == NULL_TREE && saved_desc_pointer_array (desc)) + decl = desc; + tmp = gfc_conv_array_data (desc); tmp = build_fold_indirect_ref_loc (input_location, tmp); tmp = gfc_build_array_ref (tmp, offset, decl, @@ -7590,6 +7629,10 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, tmp = build_array_ref (desc, offset, NULL, NULL); + /* If there is a saved descriptor, use it. */ + if (POINTER_TYPE_P (TREE_TYPE (tmp)) && saved_desc_pointer_array (desc)) + tmp = build_fold_indirect_ref_loc (input_location, tmp); + /* Offset the data pointer for pointer assignments from arrays with subreferences; e.g. my_integer => my_type(:)%integer_component. */ if (subref) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 47b28c1d0032..621899b3dbe6 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1408,6 +1408,11 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) GFC_DECL_SAVED_DESCRIPTOR (decl) = dummy; + if (!is_classarray && sym->attr.target && !sym->attr.value + && !sym->attr.contiguous && as->type == AS_ASSUMED_SHAPE + && packed == PACKED_NO) + GFC_DECL_PTR_ARRAY_P (decl) = 1; + if (sym->ns->proc_name->backend_decl == current_function_decl || sym->attr.contained) gfc_add_decl_to_function (decl); @@ -1786,7 +1791,10 @@ gfc_get_symbol_decl (gfc_symbol * sym) && sym->attr.allocatable) gfc_defer_symbol_init (sym); - if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS) + if (sym->attr.dimension && sym->ts.type != BT_CLASS + && (sym->attr.pointer + || (sym->attr.target && !sym->attr.contiguous + && sym->as && sym->as->type == AS_ASSUMED_RANK))) GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1; /* Create a character length variable. */ @@ -2078,6 +2086,20 @@ gfc_get_symbol_decl (gfc_symbol * sym) && !sym->attr.subref_array_pointer)) GFC_DECL_PTR_ARRAY_P (decl) = 1; + /* A SELECT RANK temporary uses a copy of the selector's descriptor. + Its elements may be spaced by more than the element size, + so use copied span as well. */ + if (sym->attr.select_rank_temporary && sym->attr.dimension + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) + && sym->assoc && sym->assoc->target + && sym->assoc->target->expr_type == EXPR_VARIABLE) + { + gfc_symbol *sel = sym->assoc->target->symtree->n.sym; + if (!sel->attr.contiguous + && (sel->attr.target || sel->attr.pointer || sel->ts.type == BT_CLASS)) + GFC_DECL_PTR_ARRAY_P (decl) = 1; + } + if (sym->ts.type == BT_CLASS) GFC_DECL_CLASS(decl) = 1; diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 33b7838f74ac..ce04b4e1ccd8 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -837,6 +837,8 @@ gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc, gfc_conv_descriptor_dtype_set (block, lhs_desc, gfc_conv_descriptor_dtype_get (rhs_desc)); + gfc_conv_descriptor_span_set (block, lhs_desc, + gfc_conv_descriptor_span_get (rhs_desc)); /* Assign the dimension as range-ref. */ lhs_dim = gfc_get_descriptor_dimension (lhs_desc); @@ -6954,6 +6956,26 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym) } +/* Return true if the actual argument for the dummy FSYM may be passed as a + copy-in/copy-out temporary. */ + +static bool +copy_in_out_allowed (gfc_symbol *fsym, bool nodesc_arg) +{ + if (fsym == NULL || nodesc_arg || fsym->as == NULL) + return true; + + if ((!fsym->attr.target && !fsym->attr.pointer) + || fsym->attr.value + || fsym->attr.contiguous) + return true; + + return fsym->as->type != AS_ASSUMED_SHAPE + && fsym->as->type != AS_ASSUMED_RANK + && !(fsym->attr.pointer && fsym->as->type == AS_DEFERRED); +} + + /* Generate code for a procedure call. Note can return se->post != NULL. If se->direct_byref is set then se->expr contains the return parameter. Return nonzero, if the call has alternate specifiers. @@ -7985,7 +8007,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (e->expr_type == EXPR_VARIABLE && is_subref_array (e) - && !(fsym && fsym->attr.pointer)) + && !(fsym && fsym->attr.pointer) + && copy_in_out_allowed (fsym, nodesc_arg)) /* The actual argument is a component reference to an array of derived types. In this case, the argument is converted to a temporary, which is passed and then @@ -8004,20 +8027,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, parmse.expr = e->symtree->n.sym->backend_decl; else if (gfc_is_class_array_ref (e, NULL) - && fsym && fsym->ts.type == BT_DERIVED) + && fsym && fsym->ts.type == BT_DERIVED + && copy_in_out_allowed (fsym, nodesc_arg)) /* The actual argument is a component reference to an array of derived types. In this case, the argument is converted to a temporary, which is passed and then - written back after the procedure call. - OOP-TODO: Insert code so that if the dynamic type is - the same as the declared type, copy-in/copy-out does - not occur. */ + written back after the procedure call. */ gfc_conv_subref_array_arg (&parmse, e, nodesc_arg, fsym->attr.intent, fsym->attr.pointer); else if (gfc_is_class_array_function (e) - && fsym && fsym->ts.type == BT_DERIVED) + && fsym && fsym->ts.type == BT_DERIVED + && copy_in_out_allowed (fsym, nodesc_arg)) /* See previous comment. For function actual argument, the write out is not needed so the intent is set as intent in. */ diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index cf37261673cf..f484303adb7c 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -389,6 +389,26 @@ gfc_build_addr_expr (tree type, tree t) } +/* Return the descriptor that carries the span of a decl marked as a pointer + array. Most decls are descriptors. A descriptorless dummy + array decl is not. The descriptor it was built from is the saved one. */ + +tree +gfc_get_span_descriptor (tree decl) +{ + if (DECL_P (decl) + && GFC_ARRAY_TYPE_P (TREE_TYPE (decl)) + && DECL_LANG_SPECIFIC (decl) + && GFC_DECL_SAVED_DESCRIPTOR (decl)) + decl = GFC_DECL_SAVED_DESCRIPTOR (decl); + + if (POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref_loc (input_location, decl); + + return decl; +} + + static tree get_array_span (tree type, tree decl) { @@ -409,7 +429,9 @@ get_array_span (tree type, tree decl) && (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE) && TYPE_STRING_FLAG (type)) { - if (TREE_CODE (decl) == PARM_DECL) + if (DECL_P (decl) && GFC_DECL_PTR_ARRAY_P (decl)) + decl = gfc_get_span_descriptor (decl); + else if (TREE_CODE (decl) == PARM_DECL) decl = build_fold_indirect_ref_loc (input_location, decl); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) span = gfc_conv_descriptor_span_get (decl); @@ -449,11 +471,7 @@ get_array_span (tree type, tree decl) span = gfc_resize_class_size_with_len (NULL, decl, span); } else if (GFC_DECL_PTR_ARRAY_P (decl)) - { - if (TREE_CODE (decl) == PARM_DECL) - decl = build_fold_indirect_ref_loc (input_location, decl); - span = gfc_conv_descriptor_span_get (decl); - } + span = gfc_conv_descriptor_span_get (gfc_get_span_descriptor (decl)); else span = NULL_TREE; } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 0bdee5820fdd..408acf081f11 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -641,6 +641,9 @@ tree gfc_build_array_ref (tree, tree, tree, /* Build an array ref using pointer arithmetic. */ tree gfc_build_spanned_array_ref (tree base, tree offset, tree span); +/* Return the descriptor holding the span of a pointer array decl. */ +tree gfc_get_span_descriptor (tree); + /* Creates a label. Decl is artificial if label_id == NULL_TREE. */ tree gfc_build_label_decl (tree); diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 index 7b1149aaa459..91547e8e3379 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 +++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 @@ -17,7 +17,9 @@ end ! { dg-final { scan-tree-dump-not " _gfortran_internal_pack" "original" } } ! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } ! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } } -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+;" 1 "original" } } -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(D.\[0-9\]+ \\* 16\\);" 1 "original" } } +! A TARGET assumed-shape dummy is addressed with the descriptor's runtime +! span, so the element offset is span-scaled instead of a constant 16. +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(yyy->span \\* D.\[0-9\]+\\) \\* 4\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.data;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } } diff --git a/gcc/testsuite/gfortran.dg/class_to_type_5.f90 b/gcc/testsuite/gfortran.dg/class_to_type_5.f90 new file mode 100644 index 000000000000..ad299db514d5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_to_type_5.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! PR 53800 + +! Check that a CLASS array with an extended dynamic type passed to an +! assumed-shape TYPE dummy aliases the original storage, rather +! than a copy-in/copy-out temporary that goes stale after return. +! +! Reported by Tobias Burnus <[email protected]> + +program class_to_type + implicit none + type t + integer :: i + end type t + type, extends(t) :: t2 + integer :: j + end type t2 + class(t), target, allocatable :: a(:,:) + type(t), pointer :: ptr + + allocate (t2 :: a(5,5)) + a(:,:)%i = 53 + a(3,3)%i = 42 + a(4,4)%i = 74 + + call f (a) + if (ptr%i /= 42) stop 1 + a(3,3)%i = 999 + if (ptr%i /= 999) stop 2 +contains + subroutine f(x) + type(t), target :: x(:,:) + ptr => x(3,3) + end subroutine f +end program class_to_type diff --git a/gcc/testsuite/gfortran.dg/class_to_type_6.f90 b/gcc/testsuite/gfortran.dg/class_to_type_6.f90 new file mode 100644 index 000000000000..67d02c67fb87 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_to_type_6.f90 @@ -0,0 +1,93 @@ +! { dg-do run } +! PR53800 + +! A CLASS array actual passed to an assumed-shape TYPE dummy only +! aliases the actual's storage when the dummy has the TARGET attribute. +! +module m + implicit none + type :: t + integer :: i + end type + type, extends(t) :: t2 + integer :: pad(4) + end type + type :: u + integer :: k + end type + type :: c + integer :: i + type(u) :: sub(3) + end type + type, extends(c) :: c2 + integer :: pad(4) + end type +contains + ! A dummy (non-target): copy-in/copy-out, + subroutine plain (x) + type(t) :: x(:) + if (any (x%i /= [1,2,3,4,5])) stop 1 + call expl (x) + if (any (cshift (x%i, 1) /= [2,3,4,5,1])) stop 3 + if (any (pack (x%i, [.true.,.false.,.true.,.false.,.true.]) & + /= [1,3,5])) stop 4 + if (any (reshape (x%i, [1,5]) /= reshape ([1,2,3,4,5], [1,5]))) stop 5 + call to_class (x) + end subroutine + + subroutine expl (y) + type(t) :: y(5) + if (any (y%i /= [1,2,3,4,5])) stop 2 + end subroutine + + subroutine to_class (z) + class(t) :: z(:) + if (any (z%i /= [1,2,3,4,5])) stop 6 + end subroutine + + ! A component sub-array of a span-carrying dummy has its own element + ! size and must not inherit the parent's span. + subroutine comp (x) + type(c), target :: x(:) + call inner (x(2)%sub) + end subroutine + + subroutine inner (s) + type(u) :: s(:) + if (any (s%k /= [21,22,23])) stop 7 + end subroutine +end module + +program class_to_type_6 + use m + implicit none + class(t), target, allocatable :: a(:) + class(c), target, allocatable :: b(:) + type(t), pointer :: p + integer :: n + + allocate (t2 :: a(5)) + do n = 1, 5 + a(n)%i = n + end do + call plain (a) + + allocate (c2 :: b(3)) + do n = 1, 3 + b(n)%i = 10 * n + b(n)%sub(:)%k = [10*n+1, 10*n+2, 10*n+3] + end do + call comp (b) + + ! A TARGET assumed-shape dummy without CONTIGUOUS does alias. + call aliased (a) + if (p%i /= 3) stop 8 + a(3)%i = 999 + if (p%i /= 999) stop 9 + +contains + subroutine aliased (x) + type(t), target :: x(:) + p => x(3) + end subroutine +end program diff --git a/gcc/testsuite/gfortran.dg/class_to_type_7.f90 b/gcc/testsuite/gfortran.dg/class_to_type_7.f90 new file mode 100644 index 000000000000..c5f74809c466 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_to_type_7.f90 @@ -0,0 +1,151 @@ +! { dg-do run } +! PR fortran/53800 + +! Further cases in which a dummy must be associated with the actual +! argument's storage rather than a copy-in/copy-out temporary: an +! intrinsic-type component of a CLASS array, a POINTER dummy and an +! assumed-rank TARGET dummy. +! +! Variations contributed by Mikael Morin <[email protected]> + +module m + implicit none + type t + integer :: i + end type t + type, extends(t) :: t2 + integer :: j + end type t2 +end module m + +! An intrinsic-type component of a CLASS array to an INTEGER TARGET dummy. +subroutine test_integer_component () + use m + implicit none + class(t), target, allocatable :: a(:,:) + integer, pointer :: ptr + + allocate (t2 :: a(5,5)) + a(:,:)%i = 53 + a(3,3)%i = 42 + + call f (a%i) + if (ptr /= 42) stop 1 + a(3,3)%i = 999 + if (ptr /= 999) stop 2 +contains + subroutine f(x) + integer, target :: x(:,:) + ptr => x(3,3) + end subroutine f +end subroutine test_integer_component + +! A component of a plain derived-type array to an INTEGER TARGET dummy. +subroutine test_subref_component () + implicit none + type u + integer :: i + integer :: pad + end type u + type(u), target :: a(5,5) + integer, pointer :: ptr + + a(:,:)%i = 53 + a(3,3)%i = 42 + + call f (a%i) + if (ptr /= 42) stop 3 + a(3,3)%i = 999 + if (ptr /= 999) stop 4 +contains + subroutine f(x) + integer, target :: x(:,:) + ptr => x(3,3) + end subroutine f +end subroutine test_subref_component + +! A character component of a derived-type array to a CHARACTER TARGET dummy. +subroutine test_character_component () + implicit none + type u + character(len=4) :: c + integer :: pad + end type u + type(u), target :: a(6) + character(len=4), pointer :: ptr + integer :: k + + do k = 1, 6 + a(k)%c = "ab00" + end do + a(4)%c = "zzzz" + + call f (a%c) + if (ptr /= "zzzz") stop 10 + a(4)%c = "qqqq" + if (ptr /= "qqqq") stop 11 +contains + subroutine f(x) + character(len=4), target :: x(:) + ptr => x(4) + end subroutine f +end subroutine test_character_component + +! A CLASS POINTER array to a TYPE POINTER dummy. +subroutine test_pointer_dummy () + use m + implicit none + class(t), pointer :: a(:,:) + type(t), pointer :: ptr + + allocate (t2 :: a(5,5)) + a(:,:)%i = 53 + a(3,3)%i = 42 + + call f (a) + if (ptr%i /= 42) stop 5 + a(3,3)%i = 999 + if (ptr%i /= 999) stop 6 + deallocate (a) +contains + subroutine f(x) + type(t), pointer :: x(:,:) + ptr => x(3,3) + end subroutine f +end subroutine test_pointer_dummy + +! A CLASS array to an assumed-rank TARGET dummy, selected with SELECT RANK. +subroutine test_assumed_rank () + use m + implicit none + class(t), target, allocatable :: a(:,:) + type(t), pointer :: ptr + + allocate (t2 :: a(5,5)) + a(:,:)%i = 53 + a(3,3)%i = 42 + + call f (a) + if (ptr%i /= 42) stop 7 + a(3,3)%i = 999 + if (ptr%i /= 999) stop 8 +contains + subroutine f(x) + type(t), target :: x(..) + select rank (x) + rank (2) + ptr => x(3,3) + rank default + error stop 9 + end select + end subroutine f +end subroutine test_assumed_rank + +program class_to_type_7 + implicit none + call test_integer_component () + call test_subref_component () + call test_character_component () + call test_pointer_dummy () + call test_assumed_rank () +end program class_to_type_7
