From 26e7468d21d2693cb887bde8efcd4ded76ee053b Mon Sep 17 00:00:00 2001 From: pault Date: Tue, 24 Jul 2007 19:16:36 +0000 Subject: 2007-07-24 Paul Thomas 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 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126886 138bc75d-0d04-0410-961f-82ee72b054a4 --- .../gfortran.dg/interface_assignment_1.f90 | 39 +++++++++++++++++ .../gfortran.dg/interface_assignment_2.f90 | 49 ++++++++++++++++++++++ 2 files changed, 88 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/interface_assignment_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/interface_assignment_2.f90 diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_1.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_1.f90 new file mode 100644 index 00000000000..6740ba14003 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_assignment_1.f90 @@ -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 +! +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" } } diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_2.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_2.f90 new file mode 100644 index 00000000000..8d7484b31bf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_assignment_2.f90 @@ -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 +! +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" } } -- cgit v1.2.1