Commit 7f6c4159 by Tobias Burnus

trans-intrinsic.c (conv_co_minmaxsum): Fix argument passing.

gcc/fortran/
2014-06-19  Tobias Burnus  <burnus@net-b.de>

        * trans-intrinsic.c (conv_co_minmaxsum): Fix argument
        passing.

gcc/testsuite/
2014-06-19  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray/collectives_2.f90: Extend
        and make valid.

libgfortran/
2014-06-19  Tobias Burnus  <burnus@net-b.de>

        * caf/single.c (_gfortran_caf_co_sum, _gfortran_caf_co_max,
        _gfortran_caf_co_min): Fix stat setting.

From-SVN: r211816
parent 29d0a43c
2014-06-19 Tobias Burnus <burnus@net-b.de>
* trans-intrinsic.c (conv_co_minmaxsum): Fix argument
passing.
2014-06-18 Tobias Burnus <burnus@net-b.de> 2014-06-18 Tobias Burnus <burnus@net-b.de>
* gfortran.texi (OpenMP): Update refs to OpenMP 4.0. * gfortran.texi (OpenMP): Update refs to OpenMP 4.0.
......
...@@ -8300,13 +8300,11 @@ conv_co_minmaxsum (gfc_code *code) ...@@ -8300,13 +8300,11 @@ conv_co_minmaxsum (gfc_code *code)
gcc_unreachable (); gcc_unreachable ();
if (code->resolved_isym->id == GFC_ISYM_CO_SUM) if (code->resolved_isym->id == GFC_ISYM_CO_SUM)
fndecl = build_call_expr_loc (input_location, fndecl, 6, array, fndecl = build_call_expr_loc (input_location, fndecl, 5, array,
null_pointer_node, image_index, stat, errmsg, image_index, stat, errmsg, errmsg_len);
errmsg_len);
else else
fndecl = build_call_expr_loc (input_location, fndecl, 7, array, fndecl = build_call_expr_loc (input_location, fndecl, 6, array, image_index,
null_pointer_node, image_index, stat, errmsg, stat, errmsg, strlen, errmsg_len);
strlen, errmsg_len);
gfc_add_expr_to_block (&block, fndecl); gfc_add_expr_to_block (&block, fndecl);
gfc_add_block_to_block (&block, &post_block); gfc_add_block_to_block (&block, &post_block);
......
2014-06-19 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray/collectives_2.f90: Extend
and make valid.
2014-06-18 Tom de Vries <tom@codesourcery.com> 2014-06-18 Tom de Vries <tom@codesourcery.com>
* gcc.target/aarch64/fuse-caller-save.c: New test. * gcc.target/aarch64/fuse-caller-save.c: New test.
2014-06-18 Radovan Obradovic <robradovic@mips.com> 2014-06-18 Radovan Obradovic <robradovic@mips.com>
Tom de Vries <tom@codesourcery.com> Tom de Vries <tom@codesourcery.com>
* gcc.target/arm/fuse-caller-save.c: New test. * gcc.target/arm/fuse-caller-save.c: New test.
......
...@@ -7,7 +7,7 @@ program test ...@@ -7,7 +7,7 @@ program test
intrinsic co_max intrinsic co_max
intrinsic co_min intrinsic co_min
intrinsic co_sum intrinsic co_sum
integer :: val(3) integer :: val(3), tmp_val(3)
integer :: vec(3) integer :: vec(3)
vec = [2,3,1] vec = [2,3,1]
if (this_image() == 1) then if (this_image() == 1) then
...@@ -21,13 +21,24 @@ program test ...@@ -21,13 +21,24 @@ program test
else else
val(3) = 101 val(3) = 101
endif endif
tmp_val = val
call test_min call test_min
val = tmp_val
call test_max call test_max
val = tmp_val
call test_sum call test_sum
contains contains
subroutine test_max subroutine test_max
call co_max (val(vec)) integer :: tmp
!write(*,*) "Maximal value", val call co_max (val(::2))
if (num_images() > 1) then
if (any (val /= [42, this_image(), 101])) call abort()
else
if (any (val /= [42, this_image(), -55])) call abort()
endif
val = tmp_val
call co_max (val(:))
if (num_images() > 1) then if (num_images() > 1) then
if (any (val /= [42, num_images(), 101])) call abort() if (any (val /= [42, num_images(), 101])) call abort()
else else
...@@ -40,20 +51,26 @@ contains ...@@ -40,20 +51,26 @@ contains
if (this_image() == num_images()) then if (this_image() == num_images()) then
!write(*,*) "Minimal value", val !write(*,*) "Minimal value", val
if (num_images() > 1) then if (num_images() > 1) then
if (any (val /= [-99, num_images(), -55])) call abort() if (any (val /= [-99, 1, -55])) call abort()
else else
if (any (val /= [42, num_images(), -55])) call abort() if (any (val /= [42, 1, -55])) call abort()
endif endif
else
if (any (val /= tmp_val)) call abort()
endif endif
end subroutine test_min end subroutine test_min
subroutine test_sum subroutine test_sum
integer :: n integer :: n
call co_sum (val, result_image=1) n = 88
call co_sum (val, result_image=1, stat=n)
if (n /= 0) call abort()
if (this_image() == 1) then if (this_image() == 1) then
n = num_images() n = num_images()
!write(*,*) "The sum is ", val !write(*,*) "The sum is ", val
if (any (val /= [42 + (n-1)*(-99), (n**2 + n)/2, -55+(n-1)*101])) call abort() if (any (val /= [42 + (n-1)*(-99), (n**2 + n)/2, -55+(n-1)*101])) call abort()
else
if (any (val /= tmp_val)) call abort()
end if end if
end subroutine test_sum end subroutine test_sum
end program test end program test
2014-06-19 Tobias Burnus <burnus@net-b.de>
* caf/single.c (_gfortran_caf_co_sum, _gfortran_caf_co_max,
_gfortran_caf_co_min): Fix stat setting.
2014-06-17 Tobias Burnus <burnus@net-b.de> 2014-06-17 Tobias Burnus <burnus@net-b.de>
* caf/libcaf.h (gfc_descriptor_t): New typedef. * caf/libcaf.h (gfc_descriptor_t): New typedef.
......
...@@ -211,7 +211,7 @@ _gfortran_caf_co_sum (gfc_descriptor_t *a __attribute__ ((unused)), ...@@ -211,7 +211,7 @@ _gfortran_caf_co_sum (gfc_descriptor_t *a __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused))) int errmsg_len __attribute__ ((unused)))
{ {
if (stat) if (stat)
stat = 0; *stat = 0;
} }
void void
...@@ -222,7 +222,7 @@ _gfortran_caf_co_min (gfc_descriptor_t *a __attribute__ ((unused)), ...@@ -222,7 +222,7 @@ _gfortran_caf_co_min (gfc_descriptor_t *a __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused))) int errmsg_len __attribute__ ((unused)))
{ {
if (stat) if (stat)
stat = 0; *stat = 0;
} }
void void
...@@ -233,7 +233,7 @@ _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)), ...@@ -233,7 +233,7 @@ _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused))) int errmsg_len __attribute__ ((unused)))
{ {
if (stat) if (stat)
stat = 0; *stat = 0;
} }
void void
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment