re PR fortran/31205 (aliased operator assignment produces wrong result)
2007-07-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/31205 PR fortran/32842 * trans-expr.c (gfc_conv_function_call): Remove the default initialization of intent(out) derived types. * symbol.c (gfc_lval_expr_from_sym): New function. * matchexp.c (gfc_get_parentheses): Return argument, if it is character and posseses a ref. * gfortran.h : Add prototype for gfc_lval_expr_from_sym. * resolve.c (has_default_initializer): Move higher up in file. (resolve_code): On detecting an interface assignment, check if the rhs and the lhs are the same symbol. If this is so, enclose the rhs in parenetheses to generate a temporary and prevent any possible aliasing. (apply_default_init): Remove code making the lval and call gfc_lval_expr_from_sym instead. (resolve_operator): Give a parentheses expression a type- spec if it has no type. * trans-decl.c (gfc_trans_deferred_vars): Apply the a default initializer, if any, to an intent(out) derived type, using gfc_lval_expr_from_sym and gfc_trans_assignment. Check if the dummy is present. 2007-07-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/31205 * gfortran.dg/alloc_comp_basics_1.f90 : Restore number of "deallocates" to 24, since patch has code rid of much spurious code. * gfortran.dg/interface_assignment_1.f90 : New test. PR fortran/32842 * gfortran.dg/interface_assignment_2.f90 : New test. From-SVN: r126886
This commit is contained in:
parent
08113c7398
commit
30f9cd05c6
|
@ -0,0 +1,39 @@
|
|||
! { dg-do run }
|
||||
! Checks the fix for PR31205, in which temporaries were not
|
||||
! written for the interface assignment and the parentheses below.
|
||||
!
|
||||
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
|
||||
!
|
||||
MODULE TT
|
||||
TYPE data_type
|
||||
INTEGER :: I=2
|
||||
END TYPE data_type
|
||||
INTERFACE ASSIGNMENT (=)
|
||||
MODULE PROCEDURE set
|
||||
END INTERFACE
|
||||
CONTAINS
|
||||
PURE SUBROUTINE set(x1,x2)
|
||||
TYPE(data_type), INTENT(IN) :: x2
|
||||
TYPE(data_type), INTENT(OUT) :: x1
|
||||
CALL S1(x1,x2)
|
||||
END SUBROUTINE
|
||||
PURE SUBROUTINE S1(x1,x2)
|
||||
TYPE(data_type), INTENT(IN) :: x2
|
||||
TYPE(data_type), INTENT(OUT) :: x1
|
||||
x1%i=x2%i
|
||||
END SUBROUTINE
|
||||
END MODULE
|
||||
|
||||
USE TT
|
||||
TYPE(data_type) :: D,E
|
||||
|
||||
D%I=4
|
||||
D=D
|
||||
|
||||
E%I=4
|
||||
CALL set(E,(E))
|
||||
|
||||
IF (D%I.NE.4) call abort ()
|
||||
IF (4.NE.E%I) call abort ()
|
||||
END
|
||||
! { dg-final { cleanup-modules "TT" } }
|
|
@ -0,0 +1,49 @@
|
|||
! { dg-do run }
|
||||
! Checks the fix for PR32842, in which the interface assignment
|
||||
! below caused a segfault. This testcase is reduced from vst_2.f95
|
||||
! in the iso_varying_string testsuite, from Lawrie Schonfelder
|
||||
!
|
||||
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
|
||||
!
|
||||
module iso_varying_string
|
||||
implicit none
|
||||
integer, parameter :: GET_BUFFER_LEN = 256
|
||||
type varying_string
|
||||
character(LEN=1), dimension(:), allocatable :: chars
|
||||
end type varying_string
|
||||
interface assignment(=)
|
||||
module procedure op_assign_VS_CH
|
||||
end interface assignment(=)
|
||||
contains
|
||||
elemental subroutine op_assign_VS_CH (var, expr)
|
||||
type(varying_string), intent(out) :: var
|
||||
character(LEN=*), intent(in) :: expr
|
||||
var = var_str(expr)
|
||||
end subroutine op_assign_VS_CH
|
||||
elemental function var_str (chr) result (string)
|
||||
character(LEN=*), intent(in) :: chr
|
||||
type(varying_string) :: string
|
||||
integer :: length
|
||||
integer :: i_char
|
||||
length = LEN(chr)
|
||||
ALLOCATE(string%chars(length))
|
||||
forall(i_char = 1:length)
|
||||
string%chars(i_char) = chr(i_char:i_char)
|
||||
end forall
|
||||
end function var_str
|
||||
end module iso_varying_string
|
||||
|
||||
PROGRAM VST_2
|
||||
USE ISO_VARYING_STRING
|
||||
IMPLICIT NONE
|
||||
CHARACTER(LEN=5) :: char_arb(2)
|
||||
CHARACTER(LEN=1) :: char_elm(10)
|
||||
equivalence (char_arb, char_elm)
|
||||
type(VARYING_STRING) :: str_ara(2)
|
||||
char_arb(1)= "Hello"
|
||||
char_arb(2)= "World"
|
||||
str_ara = char_arb
|
||||
if (any (str_ara(1)%chars(1:5) .ne. char_elm(1:5))) call abort
|
||||
if (any (str_ara(2)%chars(1:5) .ne. char_elm(6:10))) call abort
|
||||
END PROGRAM VST_2
|
||||
! { dg-final { cleanup-modules "iso_varying_string" } }
|
Loading…
Reference in New Issue