forked from wangliu-iscas/gcc-patch
-
Notifications
You must be signed in to change notification settings - Fork 3
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Fortran: do not evaluate polymorphic functions twice in assignment [P…
…R114012] PR fortran/114012 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): Evaluate non-trivial arguments just once before assigning to an unlimited polymorphic dummy variable. gcc/testsuite/ChangeLog: * gfortran.dg/pr114012.f90: New test.
- Loading branch information
1 parent
c2d62cd
commit e5f84fe
Showing
2 changed files
with
85 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,81 @@ | ||
! { dg-do run } | ||
! PR fortran/114012 | ||
! | ||
! Polymorphic functions were evaluated twice in assignment | ||
|
||
program test | ||
implicit none | ||
|
||
type :: custom_int | ||
integer :: val = 2 | ||
end type | ||
|
||
interface assignment(=) | ||
procedure assign | ||
end interface | ||
interface operator(-) | ||
procedure neg | ||
end interface | ||
|
||
type(custom_int) :: i | ||
integer :: count_assign, count_neg | ||
|
||
count_assign = 0 | ||
count_neg = 0 | ||
|
||
i = 1 | ||
if (count_assign /= 1 .or. count_neg /= 0) stop 1 | ||
|
||
i = -i | ||
if (count_assign /= 2 .or. count_neg /= 1) stop 2 | ||
if (i% val /= -1) stop 3 | ||
|
||
i = neg(i) | ||
if (count_assign /= 3 .or. count_neg /= 2) stop 4 | ||
if (i% val /= 1) stop 5 | ||
|
||
i = (neg(i)) | ||
if (count_assign /= 4 .or. count_neg /= 3) stop 6 | ||
if (i% val /= -1) stop 7 | ||
|
||
i = - neg(i) | ||
if (count_assign /= 5 .or. count_neg /= 5) stop 8 | ||
if (i% val /= -1) stop 9 | ||
|
||
contains | ||
|
||
subroutine assign (field, val) | ||
type(custom_int), intent(out) :: field | ||
class(*), intent(in) :: val | ||
|
||
count_assign = count_assign + 1 | ||
|
||
select type (val) | ||
type is (integer) | ||
! print *, " in assign(integer)", field%val, val | ||
field%val = val | ||
type is (custom_int) | ||
! print *, " in assign(custom)", field%val, val%val | ||
field%val = val%val | ||
class default | ||
error stop | ||
end select | ||
|
||
end subroutine assign | ||
|
||
function neg (input_field) result(output_field) | ||
type(custom_int), intent(in), target :: input_field | ||
class(custom_int), allocatable :: output_field | ||
allocate (custom_int :: output_field) | ||
|
||
count_neg = count_neg + 1 | ||
|
||
select type (output_field) | ||
type is (custom_int) | ||
! print *, " in neg", output_field%val, input_field%val | ||
output_field%val = -input_field%val | ||
class default | ||
error stop | ||
end select | ||
end function neg | ||
end program test |