gfortran.texi: Document additional src/dst_type.

gcc/fortran/ChangeLog:

2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.texi: Document additional src/dst_type.  Fix some typos.
	* trans-decl.c (gfc_build_builtin_function_decls): Declare the new
	argument of _caf_*_by_ref () with * e { get, send, sendget }.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Add the type of the
	data referenced when generating a call to caf_get_by_ref ().
	(conv_caf_send): Same but for caf_send_by_ref () and
	caf_sendget_by_ref ().

gcc/testsuite/ChangeLog:

2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray_alloc_comp_6.f08: New test.
	* gfortran.dg/coarray_alloc_comp_7.f08: New test.
	* gfortran.dg/coarray_alloc_comp_8.f08: New test.

libgfortran/ChangeLog:

2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* caf/libcaf.h: Add type parameters to the caf_*_by_ref prototypes.
	* caf/single.c (get_for_ref): Simplifications and now respecting
	the type argument.
	(_gfortran_caf_get_by_ref): Added source type handing to get_for_ref().
	(send_by_ref): Simplifications and respecting the dst_type now.
	(_gfortran_caf_send_by_ref): Added destination type hand over to
	send_by_ref().
	(_gfortran_caf_sendget_by_ref): Added general support and fixed stack
	corruption.  The function is now really usable.

From-SVN: r257813

8 files changed, 233 insertions, 20 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 01f9c5e..e75361b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* gfortran.texi: Document additional src/dst_type.  Fix some typos.
+	* trans-decl.c (gfc_build_builtin_function_decls): Declare the new
+	argument of _caf_*_by_ref () with * e { get, send, sendget }.
+	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Add the type of the
+	data referenced when generating a call to caf_get_by_ref ().
+	(conv_caf_send): Same but for caf_send_by_ref () and
+	caf_sendget_by_ref ().
+
 2018-02-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/84389
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 9ffe6ad..db48a71 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4750,7 +4750,7 @@ remote image identified by the @var{image_index}.
 @item @emph{Syntax}:
 @code{void _gfortran_caf_send_by_ref (caf_token_t token, int image_index,
 gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind, int src_kind,
-bool may_require_tmp, bool dst_reallocatable, int *stat)}
+bool may_require_tmp, bool dst_reallocatable, int *stat, int dst_type)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -4774,6 +4774,9 @@ is a full array or component ref.
 @item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the
 operation, i.e., zero on success and non-zero on error.  When @code{NULL} and
 an error occurs, then an error message is printed and the program is terminated.
+@item @var{dst_type} @tab intent(in)  Give the type of the destination.  When
+the destination is not an array, than the precise type, e.g. of a component in
+a derived type, is not known, but provided here.
 @end multitable
 
 @item @emph{NOTES}
@@ -4808,7 +4811,7 @@ identified by the @var{image_index}.
 @item @emph{Syntax}:
 @code{void _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
 caf_reference_t *refs, gfc_descriptor_t *dst, int dst_kind, int src_kind,
-bool may_require_tmp, bool dst_reallocatable, int *stat)}
+bool may_require_tmp, bool dst_reallocatable, int *stat, int src_type)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -4833,6 +4836,9 @@ array or a component is referenced.
 @item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the
 operation, i.e., zero on success and non-zero on error.  When @code{NULL} and an
 error occurs, then an error message is printed and the program is terminated.
+@item @var{src_type} @tab intent(in)  Give the type of the source.  When the
+source is not an array, than the precise type, e.g. of a component in a
+derived type, is not known, but provided here.
 @end multitable
 
 @item @emph{NOTES}
@@ -4868,7 +4874,8 @@ identified by the @var{src_image_index} to a remote image identified by the
 @code{void _gfortran_caf_sendget_by_ref (caf_token_t dst_token,
 int dst_image_index, caf_reference_t *dst_refs,
 caf_token_t src_token, int src_image_index, caf_reference_t *src_refs,
-int dst_kind, int src_kind, bool may_require_tmp, int *dst_stat, int *src_stat)}
+int dst_kind, int src_kind, bool may_require_tmp, int *dst_stat,
+int *src_stat, int dst_type, int src_type)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -4899,6 +4906,12 @@ program is terminated.
 the get-operation, i.e., zero on success and non-zero on error.  When
 @code{NULL} and an error occurs, then an error message is printed and the
 program is terminated.
+@item @var{dst_type} @tab intent(in)  Give the type of the destination.  When
+the destination is not an array, than the precise type, e.g. of a component in
+a derived type, is not known, but provided here.
+@item @var{src_type} @tab intent(in)  Give the type of the source.  When the
+source is not an array, than the precise type, e.g. of a component in a
+derived type, is not known, but provided here.
 @end multitable
 
 @item @emph{NOTES}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4fc07b6..51de933 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3662,24 +3662,25 @@ gfc_build_builtin_function_decls (void)
 	integer_type_node, boolean_type_node, integer_type_node);
 
       gfor_fndecl_caf_get_by_ref = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_get_by_ref")), ".RWRRRRRW", void_type_node,
-	9, pvoid_type_node, integer_type_node, pvoid_type_node, pvoid_type_node,
-	integer_type_node, integer_type_node, boolean_type_node,
-	boolean_type_node, pint_type);
+	get_identifier (PREFIX("caf_get_by_ref")), ".RWRRRRRWR", void_type_node,
+	10, pvoid_type_node, integer_type_node, pvoid_type_node,
+	pvoid_type_node, integer_type_node, integer_type_node,
+	boolean_type_node, boolean_type_node, pint_type, integer_type_node);
 
       gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send_by_ref")), ".RRRRRRRW", void_type_node,
-	9, pvoid_type_node, integer_type_node, pvoid_type_node, pvoid_type_node,
-	integer_type_node, integer_type_node, boolean_type_node,
-	boolean_type_node, pint_type);
+	get_identifier (PREFIX("caf_send_by_ref")), ".RRRRRRRWR",
+	void_type_node,	10, pvoid_type_node, integer_type_node, pvoid_type_node,
+	pvoid_type_node, integer_type_node, integer_type_node,
+	boolean_type_node, boolean_type_node, pint_type, integer_type_node);
 
       gfor_fndecl_caf_sendget_by_ref
 	  = gfc_build_library_function_decl_with_spec (
-	    get_identifier (PREFIX("caf_sendget_by_ref")), ".RR.RRRRRWW",
-	    void_type_node, 11, pvoid_type_node, integer_type_node,
+	    get_identifier (PREFIX("caf_sendget_by_ref")), ".RR.RRRRRWWRR",
+	    void_type_node, 13, pvoid_type_node, integer_type_node,
 	    pvoid_type_node, pvoid_type_node, integer_type_node,
 	    pvoid_type_node, integer_type_node, integer_type_node,
-	    boolean_type_node, pint_type, pint_type);
+	    boolean_type_node, pint_type, pint_type, integer_type_node,
+	    integer_type_node);
 
       gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 337227d..dd49216 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1709,12 +1709,13 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 	  gfc_add_expr_to_block (&se->pre, tmp);
 
 	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get_by_ref,
-				     9, token, image_index, dst_var,
+				     10, token, image_index, dst_var,
 				     caf_reference, lhs_kind, kind,
 				     may_require_tmp,
 				     may_realloc ? boolean_true_node :
 						   boolean_false_node,
-				     stat);
+				     stat, build_int_cst (integer_type_node,
+							  array_expr->ts.type));
 
 	  gfc_add_expr_to_block (&se->pre, tmp);
 
@@ -2100,9 +2101,11 @@ conv_caf_send (gfc_code *code) {
 					     : boolean_false_node;
 	  tmp = build_call_expr_loc (input_location,
 				     gfor_fndecl_caf_send_by_ref,
-				     9, token, image_index, rhs_se.expr,
+				     10, token, image_index, rhs_se.expr,
 				     reference, lhs_kind, rhs_kind,
-				     may_require_tmp, dst_realloc, src_stat);
+				     may_require_tmp, dst_realloc, src_stat,
+				     build_int_cst (integer_type_node,
+						    lhs_expr->ts.type));
 	  }
       else
 	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 11,
@@ -2147,11 +2150,15 @@ conv_caf_send (gfc_code *code) {
 	  lhs_reference = conv_expr_ref_to_caf_ref (&block, lhs_expr);
 	  rhs_reference = conv_expr_ref_to_caf_ref (&block, rhs_expr);
 	  tmp = build_call_expr_loc (input_location,
-				     gfor_fndecl_caf_sendget_by_ref, 11,
+				     gfor_fndecl_caf_sendget_by_ref, 13,
 				     token, image_index, lhs_reference,
 				     rhs_token, rhs_image_index, rhs_reference,
 				     lhs_kind, rhs_kind, may_require_tmp,
-				     dst_stat, src_stat);
+				     dst_stat, src_stat,
+				     build_int_cst (integer_type_node,
+						    lhs_expr->ts.type),
+				     build_int_cst (integer_type_node,
+						    rhs_expr->ts.type));
 	}
       else
 	{
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6adc78e..ef615a4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* gfortran.dg/coarray_alloc_comp_6.f08: New test.
+	* gfortran.dg/coarray_alloc_comp_7.f08: New test.
+	* gfortran.dg/coarray_alloc_comp_8.f08: New test.
+
 2018-02-19  Carl Love  <cel@us.ibm.com>
 
 	* gcc.target/powerpc/fold-vec-neg-int.p7.c: Remove test file.
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08
new file mode 100644
index 0000000..a37554f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+
+! Check that type conversion during caf_get_by_ref is done for components.
+
+program main
+
+  implicit none
+
+  type :: mytype
+    integer :: i
+    integer :: i4 
+    integer(kind=1) :: i1
+    real :: r8
+    real(kind=4) :: r4
+    integer :: arr_i4(4)
+    integer(kind=1) :: arr_i1(4)
+    real :: arr_r8(4)
+    real(kind=4) :: arr_r4(4)
+  end type
+
+  type T
+    type(mytype), allocatable :: obj
+  end type T
+
+  type(T), save :: bar[*]
+  integer :: i4, arr_i4(4)
+  integer(kind=1) :: i1, arr_i1(4)
+  real :: r8, arr_r8(4)
+  real(kind=4) :: r4, arr_r4(4)
+
+  bar%obj = mytype(42, 4, INT(1, 1), 8.0, REAL(4.0, 4), (/ 1,2,3,4 /), &
+  &       INT((/ 5,6,7,8 /), 1), (/ 1.2,3.4,5.6,7.8 /), REAL( &
+  &       (/ 8.7,6.5,4.3,2.1 /), 4))
+
+  i1 = bar[1]%obj%r4
+  if (i1 /= 4) stop 1
+  i4 = bar[1]%obj%r8
+  if (i4 /= 8) stop 2
+  r4 = bar[1]%obj%i1
+  if (abs(r4 - 1.0) > 1E-4) stop 3
+  r8 = bar[1]%obj%i4
+  if (abs(r8 - 4.0) > 1E-6) stop 4
+
+  arr_i1 = bar[1]%obj%arr_r4
+  if (any(arr_i1 /= INT((/ 8,6,4,2 /), 1))) stop 5
+  arr_i4 = bar[1]%obj%arr_r8
+  if (any(arr_i4 /= (/ 1,3,5,7 /))) stop 6
+  arr_r4 = bar[1]%obj%arr_i1
+  if (any(abs(arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 7
+  arr_r8 = bar[1]%obj%arr_i4
+  if (any(abs(arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 8
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08
new file mode 100644
index 0000000..9392582
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+
+! Check that type conversion during caf_send_by_ref is done for components.
+
+program main
+
+  implicit none
+
+  type :: mytype
+    integer :: i
+    integer :: i4 
+    integer(kind=1) :: i1
+    real :: r8
+    real(kind=4) :: r4
+    integer :: arr_i4(4)
+    integer(kind=1) :: arr_i1(4)
+    real :: arr_r8(4)
+    real(kind=4) :: arr_r4(4)
+  end type
+
+  type T
+    type(mytype), allocatable :: obj
+  end type T
+
+  type(T), save :: bar[*]
+  integer :: i4, arr_i4(4)
+  integer(kind=1) :: i1, arr_i1(4)
+  real :: r8, arr_r8(4)
+  real(kind=4) :: r4, arr_r4(4)
+
+  allocate(bar%obj)
+  i1 = INT(1, 1)
+  i4 = 4
+  r4 = REAL(4.0, 4)
+  r8 = 8.0
+  arr_i1 = INT((/ 5,6,7,8 /), 1)
+  arr_i4 = (/ 1,2,3,4 /)
+  arr_r8 = (/ 1.2,3.4,5.6,7.8 /)
+  arr_r4 = REAL((/ 8.7,6.5,4.3,2.1 /), 4)
+
+  bar[1]%obj%r4 = i1
+  if (abs(bar%obj%r4 - 1.0) > 1E-4) stop 1
+  bar[1]%obj%r8 = i4
+  if (abs(bar%obj%r8 - 4.0) > 1E-6) stop 2
+  bar[1]%obj%i1 = r4
+  if (bar%obj%i1 /= 4) stop 3
+  bar[1]%obj%i4 = r8
+  if (bar%obj%i4 /= 8) stop 4
+
+  bar[1]%obj%arr_r4 = arr_i1
+  print *, bar%obj%arr_r4
+  if (any(abs(bar%obj%arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 5
+  bar[1]%obj%arr_r8 = arr_i4
+  if (any(abs(bar%obj%arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 6
+  bar[1]%obj%arr_i1 = arr_r4
+  if (any(bar%obj%arr_i1 /= INT((/ 8,6,4,2 /), 1))) stop 7
+  bar[1]%obj%arr_i4 = arr_r8
+  if (any(bar%obj%arr_i4 /= (/ 1,3,5,7 /))) stop 8
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08
new file mode 100644
index 0000000..679bec3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+
+! Check that type conversion during caf_sendget_by_ref is done for components.
+
+program main
+
+  implicit none
+
+  type :: mytype
+    integer :: i
+    integer :: i4 
+    integer(kind=1) :: i1
+    real :: r8
+    real(kind=4) :: r4
+    integer :: arr_i4(4)
+    integer(kind=1) :: arr_i1(4)
+    real :: arr_r8(4)
+    real(kind=4) :: arr_r4(4)
+  end type
+
+  type T
+    type(mytype), allocatable :: obj
+  end type T
+
+  type(T), save :: bar[*]
+  integer :: i4, arr_i4(4)
+  integer(kind=1) :: i1, arr_i1(4)
+  real :: r8, arr_r8(4)
+  real(kind=4) :: r4, arr_r4(4)
+
+  bar%obj = mytype(42, 4, INT(1, 1), 8.0, REAL(4.0, 4), (/ 1,2,3,4 /), &
+  &       INT((/ 5,6,7,8 /), 1), (/ 1.2,3.4,5.6,7.8 /), REAL( &
+  &       (/ 8.7,6.5,4.3,2.1 /), 4))
+
+  bar[1]%obj%i1 = bar[1]%obj%r4
+  if (bar%obj%i1 /= 4) stop 1
+  bar[1]%obj%i4 = bar[1]%obj%r8
+  if (bar%obj%i4 /= 8) stop 2
+  bar[1]%obj%arr_i1 = bar[1]%obj%arr_r4
+  if (any(bar%obj%arr_i1 /= (/ 8,6,4,2 /))) stop 3
+  bar[1]%obj%arr_i4 = bar[1]%obj%arr_r8
+  if (any(bar%obj%arr_i4 /= (/ 1,3,5,7 /))) stop 4
+
+  bar%obj%i1 = INT(1, 1)
+  bar%obj%i4 = 4
+  bar%obj%arr_i1 = INT((/ 5,6,7,8 /), 1)
+  bar%obj%arr_i4 = (/ 1,2,3,4 /)
+  bar[1]%obj%r4 = bar[1]%obj%i1
+  if (abs(bar%obj%r4 - 1.0) > 1E-4) stop 5
+  bar[1]%obj%r8 = bar[1]%obj%i4
+  if (abs(bar%obj%r8 - 4.0) > 1E-6) stop 6
+  bar[1]%obj%arr_r4 = bar[1]%obj%arr_i1
+  if (any(abs(bar%obj%arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 7
+  bar[1]%obj%arr_r8 = bar[1]%obj%arr_i4
+  if (any(abs(bar%obj%arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 8
+end program
+