From: Tobias Burnus Date: Wed, 30 Apr 2014 19:10:16 +0000 (+0200) Subject: trans-decl.c (create_function_arglist): Add hidden coarray X-Git-Tag: releases/gcc-5.1.0~7836 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=598cc4fada2da6388903a749f33f94c696685b09;p=thirdparty%2Fgcc.git trans-decl.c (create_function_arglist): Add hidden coarray 2014-04-30 Tobias Burnus * trans-decl.c (create_function_arglist): Add hidden coarray * arguments also for polymorphic coarrays. * trans-expr.c (gfc_conv_procedure_call): Pass hidden coarray arguments also for polymorphic coarrays. 2014-04-30 Tobias Burnus * gfortran.dg/coarray_poly_7.f90 * gfortran.dg/coarray_poly_8.f90 * gfortran.dg/coarray_poly_9.f90 From-SVN: r209953 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1dcde5db695c..b991dc0b115c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2014-04-30 Tobias Burnus + + * trans-decl.c (create_function_arglist): Add hidden coarray arguments + also for polymorphic coarrays. + * trans-expr.c (gfc_conv_procedure_call): Pass hidden coarray arguments + also for polymorphic coarrays. + 2014-04-30 Tobias Burnus * resolve.c (resolve_function): Don't do diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c835a3b34de3..ee6c7e3004d3 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2234,9 +2234,12 @@ create_function_arglist (gfc_symbol * sym) /* Coarrays which are descriptorless or assumed-shape pass with -fcoarray=lib the token and the offset as hidden arguments. */ - if (f->sym->attr.codimension - && gfc_option.coarray == GFC_FCOARRAY_LIB - && !f->sym->attr.allocatable) + if (gfc_option.coarray == GFC_FCOARRAY_LIB + && ((f->sym->ts.type != BT_CLASS && f->sym->attr.codimension + && !f->sym->attr.allocatable) + || (f->sym->ts.type == BT_CLASS + && CLASS_DATA (f->sym)->attr.codimension + && !CLASS_DATA (f->sym)->attr.allocatable))) { tree caf_type; tree token; @@ -2244,13 +2247,18 @@ create_function_arglist (gfc_symbol * sym) gcc_assert (f->sym->backend_decl != NULL_TREE && !sym->attr.is_bind_c); - caf_type = TREE_TYPE (f->sym->backend_decl); + caf_type = f->sym->ts.type == BT_CLASS + ? TREE_TYPE (CLASS_DATA (f->sym)->backend_decl) + : TREE_TYPE (f->sym->backend_decl); token = build_decl (input_location, PARM_DECL, create_tmp_var_name ("caf_token"), build_qualified_type (pvoid_type_node, TYPE_QUAL_RESTRICT)); - if (f->sym->as->type == AS_ASSUMED_SHAPE) + if ((f->sym->ts.type != BT_CLASS + && f->sym->as->type != AS_DEFERRED) + || (f->sym->ts.type == BT_CLASS + && CLASS_DATA (f->sym)->as->type != AS_DEFERRED)) { gcc_assert (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL || GFC_DECL_TOKEN (f->sym->backend_decl) == NULL_TREE); @@ -2275,7 +2283,10 @@ create_function_arglist (gfc_symbol * sym) create_tmp_var_name ("caf_offset"), gfc_array_index_type); - if (f->sym->as->type == AS_ASSUMED_SHAPE) + if ((f->sym->ts.type != BT_CLASS + && f->sym->as->type != AS_DEFERRED) + || (f->sym->ts.type == BT_CLASS + && CLASS_DATA (f->sym)->as->type != AS_DEFERRED)) { gcc_assert (GFC_DECL_CAF_OFFSET (f->sym->backend_decl) == NULL_TREE); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f0e5b7ddc2f0..6b9353767efc 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4783,19 +4783,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* For descriptorless coarrays and assumed-shape coarray dummies, we pass the token and the offset as additional arguments. */ - if (fsym && fsym->attr.codimension - && gfc_option.coarray == GFC_FCOARRAY_LIB - && !fsym->attr.allocatable - && e == NULL) + if (fsym && e == NULL && gfc_option.coarray == GFC_FCOARRAY_LIB + && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension + && !fsym->attr.allocatable) + || (fsym->ts.type == BT_CLASS + && CLASS_DATA (fsym)->attr.codimension + && !CLASS_DATA (fsym)->attr.allocatable))) { /* Token and offset. */ vec_safe_push (stringargs, null_pointer_node); vec_safe_push (stringargs, build_int_cst (gfc_array_index_type, 0)); gcc_assert (fsym->attr.optional); } - else if (fsym && fsym->attr.codimension - && !fsym->attr.allocatable - && gfc_option.coarray == GFC_FCOARRAY_LIB) + else if (fsym && gfc_option.coarray == GFC_FCOARRAY_LIB + && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension + && !fsym->attr.allocatable) + || (fsym->ts.type == BT_CLASS + && CLASS_DATA (fsym)->attr.codimension + && !CLASS_DATA (fsym)->attr.allocatable))) { tree caf_decl, caf_type; tree offset, tmp2; @@ -4837,22 +4842,30 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = caf_decl; } - if (fsym->as->type == AS_ASSUMED_SHAPE - || (fsym->as->type == AS_ASSUMED_RANK && !fsym->attr.pointer - && !fsym->attr.allocatable)) + tmp2 = fsym->ts.type == BT_CLASS + ? gfc_class_data_get (parmse.expr) : parmse.expr; + if ((fsym->ts.type != BT_CLASS + && (fsym->as->type == AS_ASSUMED_SHAPE + || fsym->as->type == AS_ASSUMED_RANK)) + || (fsym->ts.type == BT_CLASS + && (CLASS_DATA (fsym)->as->type == AS_ASSUMED_SHAPE + || CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK))) { - gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr))); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE - (TREE_TYPE (parmse.expr)))); - tmp2 = build_fold_indirect_ref_loc (input_location, parmse.expr); + if (fsym->ts.type == BT_CLASS) + gcc_assert (!POINTER_TYPE_P (TREE_TYPE (tmp2))); + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp2))); + tmp2 = build_fold_indirect_ref_loc (input_location, tmp2); + } + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2))); tmp2 = gfc_conv_descriptor_data_get (tmp2); } - else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr))) - tmp2 = gfc_conv_descriptor_data_get (parmse.expr); + else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2))) + tmp2 = gfc_conv_descriptor_data_get (tmp2); else { - gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr))); - tmp2 = parmse.expr; + gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp2))); } tmp = fold_build2_loc (input_location, MINUS_EXPR, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 862f133d8789..c0c61b2cd9db 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-04-30 Tobias Burnus + + * gfortran.dg/coarray_poly_7.f90 + * gfortran.dg/coarray_poly_8.f90 + * gfortran.dg/coarray_poly_9.f90 + 2014-04-30 Tobias Burnus * gfortran.dg/coarray_lib_this_image_2.f90: Update dump. diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 new file mode 100644 index 000000000000..aeafa7eb3d66 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! + implicit none + type t + end type t + class(t), allocatable :: y[:] + call bar() + call foo(y) +contains + subroutine bar(x) + class(t), optional :: x[*] + end subroutine bar + subroutine foo(x) + class(t) :: x[*] + end subroutine foo +end +! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_0_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=8\\)\\) class..._data.data - \\(integer\\(kind=8\\)\\) y._data._data.data\\);" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 new file mode 100644 index 000000000000..f33ecbe84229 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! + implicit none + type t + end type t + class(t), allocatable :: y(:)[:] + call bar() + call foo(y) +contains + subroutine bar(x) + class(t), optional :: x(:)[*] + end subroutine bar + subroutine foo(x) + class(t) :: x(:)[*] + end subroutine foo +end +! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=8\\)\\) class..._data.data - \\(integer\\(kind=8\\)\\) y._data._data.data\\);" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 new file mode 100644 index 000000000000..65ad29c6b302 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! + implicit none + type t + end type t + class(t), allocatable :: y(:)[:] + call bar() + call foo(y) +contains + subroutine bar(x) + class(t), optional :: x(2)[*] + end subroutine bar + subroutine foo(x) + class(t) :: x(2)[*] + end subroutine foo +end +! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=8\\)\\) class..._data.data - \\(integer\\(kind=8\\)\\) y._data._data.data\\);" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } }