re PR fortran/41044 (internal compiler error: in gfc_conv_intrinsic_function)

2010-01-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/41044
	PR fortran/41167
	* expr.c (remove_subobject_ref): If the constructor is NULL use
	the expression as the source.
	(simplify_const_ref): Change the type of expression if
	there are component references.  Allow for substring to be at
	the end of an arbitrarily long chain of references.  If an
	element is found that is not in an EXPR_ARRAY, assume that this
	is scalar initialization of array. Call remove_subobject_ref in
	this case with NULL second argument.

2010-01-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/41044
	* gfortran.dg/parameter_array_ref_2.f90 : New test.

	PR fortran/41167
	* gfortran.dg/char_array_arg_1.f90 : New test.

	* gfortran.dg/pr25923.f90 : Remove XFAIL.

From-SVN: r156197

6 files changed, 111 insertions, 12 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ae4fa51..760fc24 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2010-01-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41044
+	PR fortran/41167
+	* expr.c (remove_subobject_ref): If the constructor is NULL use
+	the expression as the source.
+	(simplify_const_ref): Change the type of expression if
+	there are component references.  Allow for substring to be at
+	the end of an arbitrarily long chain of references.  If an
+	element is found that is not in an EXPR_ARRAY, assume that this
+	is scalar initialization of array. Call remove_subobject_ref in
+	this case with NULL second argument.
+
 2010-01-24  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/39304
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8fa46d8..d846c0f 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1154,8 +1154,13 @@ remove_subobject_ref (gfc_expr *p, gfc_constructor *cons)
 {
   gfc_expr *e;
 
-  e = cons->expr;
-  cons->expr = NULL;
+  if (cons)
+    {
+      e = cons->expr;
+      cons->expr = NULL;
+    }
+  else
+    e = gfc_copy_expr (p);
   e->ref = p->ref->next;
   p->ref->next =  NULL;
   gfc_replace_expr (p, e);
@@ -1464,6 +1469,7 @@ simplify_const_ref (gfc_expr *p)
 {
   gfc_constructor *cons;
   gfc_expr *newp;
+  gfc_ref *last_ref;
 
   while (p->ref)
     {
@@ -1473,6 +1479,13 @@ simplify_const_ref (gfc_expr *p)
 	  switch (p->ref->u.ar.type)
 	    {
 	    case AR_ELEMENT:
+	      /* <type/kind spec>, parameter :: x(<int>) = scalar_expr
+		 will generate this.  */
+	      if (p->expr_type != EXPR_ARRAY)
+		{
+		  remove_subobject_ref (p, NULL);
+		  break;
+		}
 	      if (find_array_element (p->value.constructor, &p->ref->u.ar,
 				      &cons) == FAILURE)
 		return FAILURE;
@@ -1502,18 +1515,25 @@ simplify_const_ref (gfc_expr *p)
 			return FAILURE;
 		    }
 
-		  /* If this is a CHARACTER array and we possibly took a
-		     substring out of it, update the type-spec's character
-		     length according to the first element (as all should have
-		     the same length).  */
-		  if (p->ts.type == BT_CHARACTER)
+		  if (p->ts.type == BT_DERIVED
+			&& p->ref->next
+			&& p->value.constructor)
 		    {
-		      int string_len;
+		      /* There may have been component references.  */
+		      p->ts = p->value.constructor->expr->ts;
+		    }
 
-		      gcc_assert (p->ref->next);
-		      gcc_assert (!p->ref->next->next);
-		      gcc_assert (p->ref->next->type == REF_SUBSTRING);
+		  last_ref = p->ref;
+		  for (; last_ref->next; last_ref = last_ref->next) {};
 
+		  if (p->ts.type == BT_CHARACTER
+			&& last_ref->type == REF_SUBSTRING)
+		    {
+		      /* If this is a CHARACTER array and we possibly took
+			 a substring out of it, update the type-spec's
+			 character length according to the first element
+			 (as all should have the same length).  */
+		      int string_len;
 		      if (p->value.constructor)
 			{
 			  const gfc_expr* first = p->value.constructor->expr;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c9a6fdc..b9dd124 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2010-01-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41044
+	* gfortran.dg/parameter_array_ref_2.f90 : New test.
+
+	PR fortran/41167
+	* gfortran.dg/char_array_arg_1.f90 : New test.
+
+	* gfortran.dg/pr25923.f90 : Remove XFAIL.
+
 2010-01-24  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/39304
diff --git a/gcc/testsuite/gfortran.dg/char_array_arg_1.f90 b/gcc/testsuite/gfortran.dg/char_array_arg_1.f90
new file mode 100644
index 0000000..097fbc6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_array_arg_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Test the fix for pr41167, in which the first argument of 'pack', below,
+! was simplified incorrectly, with the results indicated.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug88
+  implicit none
+  type t
+     character(len=8) :: name
+  end type t
+  type(t) ,parameter :: obstyp(2)= (/ t ('A'), t ('B') /)
+  character(9) :: chr(1)
+
+  print *, pack (" "//obstyp(:)% name, (/ .true., .false. /))  ! Used to ICE on compilation
+  chr = pack (" "//obstyp(:)% name, (/ .true., .false. /))  ! Used to give conversion error
+end program gfcbug88
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90 b/gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90
new file mode 100644
index 0000000..30f300f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! Test the fix for the problems in PR41044
+!
+! Contributed by <ros@rzg.mpg.de>
+! Reduced by Joos VandeVondele <jv244@cam.ac.uk>
+!
+  Subroutine PS_INIT (bkgd, punit, pform, psize, rot90, bbox, clip, eps,  &
+                        caller)
+    type psfd                          ! paper size and frame defaults
+      character(3)                     :: n
+      real                             :: p(2)
+      real                             :: f(4)
+    end type psfd
+    character(4)                       :: fn, orich, pfmt
+    type(psfd), parameter              :: pfd(0:11)=(/  &
+         psfd('   ',(/   0.0,   0.0/),(/200.,120.,800.,560./)), &    ! A0_L
+         psfd('A0 ',(/ 840.9,1189.2/),(/140., 84.,560.,400./)), &    ! A0_P
+         psfd('A1 ',(/ 594.6, 840.9/),(/100., 60.,400.,280./)), &    ! A1_P
+         psfd('A2 ',(/ 420.4, 594.6/),(/ 70., 42.,280.,200./)), &    ! A2_P
+         psfd('A3 ',(/ 297.3, 420.4/),(/ 50., 30.,200.,140./)), &    ! A3_P
+         psfd('A4 ',(/ 210.2, 297.3/),(/ 35., 21.,140.,100./)), &    ! A4_P
+         psfd('A5 ',(/ 148.7, 210.2/),(/ 25., 15.,100., 70./)), &    ! A5_P
+         psfd('A6 ',(/ 105.1, 148.7/),(/ 18., 11., 70., 50./)), &    ! A6_P
+         psfd('   ',(/   0.0,   0.0/),(/ 50., 30.,200.,140./)), &    ! Letter_L
+         psfd('LET',(/ 215.9, 279.4/),(/ 35., 21.,140.,100./)), &    ! Letter_P
+         psfd('   ',(/   0.0,   0.0/),(/ 50., 30.,200.,140./)), &    ! Legal_L
+         psfd('LEG',(/ 215.9, 355.6/),(/ 35., 21.,140.,100./))/)     ! Legal_P
+    if (len_trim(pfmt) > 0) then       ! set paper format
+      idx=sum(maxloc(index(pfd%n,pfmt(1:3))))-1
+    end if
+  end subroutine PS_INIT
+
+! This, additional problem, was posted as comment #8 by Tobias Burnus <burnus@gcc.gnu.org>
+  type t
+    integer :: i
+  end type t
+  type(t), parameter :: a(1) = t(4) ! [t(4)] worked OK
+  real(a(1)%i) :: b
+end
diff --git a/gcc/testsuite/gfortran.dg/pr25923.f90 b/gcc/testsuite/gfortran.dg/pr25923.f90
index b6979ec..f075944 100644
--- a/gcc/testsuite/gfortran.dg/pr25923.f90
+++ b/gcc/testsuite/gfortran.dg/pr25923.f90
@@ -10,7 +10,7 @@ implicit none
 
 contains
 
-  function baz(arg) result(res) ! { dg-warning "res.yr' may be" "" { xfail *-*-* } }
+  function baz(arg) result(res) ! { dg-warning "res.yr' may be" }
     type(bar), intent(in) :: arg
     type(bar) :: res
     logical, external:: some_func