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

gcc/testsuite/gfortran.dg/interface_assignment_1.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/interface_assignment_2.f90

+! { 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" } }