[patch, libfortran] Fix PR 31196

[Thomas Koenig]

:ADDPATCH fortran:

Hello world,

this one-liner fixes PR 31196, where reshape of a
transposed array led to silent wrong results.

Currently regtesting on i686-pc-linux-gnu.  OK for 4.3
if this passes?  OK for 4.2?

Thomas

2007-03-24  Thomas Koenig  <[EMAIL PROTECTED]>

* intrinsic/reshape_generic.c (reshape_internal):  Increment
correct variable.

! { dg-do run }
! PR 31196 - reshape of transposed derived types generated
!wront results.
program main
  implicit none
  TYPE datatype
 INTEGER :: I
  END TYPE datatype
  character (len=20) line1, line2
  TYPE(datatype), dimension(2,2) :: data, result
  data(1,1)%i = 1
  data(2,1)%i = 2
  data(1,2)%i = 3
  data(2,2)%i = 4
  write (unit=line1, fmt="(4I4)") reshape(transpose(data),shape(data))
  write (unit=line2, fmt="(4I4)") (/ 1, 3, 2, 4 /)
  if (line1 /= line2) call abort
END program main
Index: intrinsics/reshape_generic.c
===
--- intrinsics/reshape_generic.c	(revision 123028)
+++ intrinsics/reshape_generic.c	(working copy)
@@ -266,7 +266,7 @@ reshape_internal (parray *ret, parray *s
   else
 {
   scount[n]++;
-  sptr += sstride[n] * size;
+  src += sstride[n] * size;
 }
 }
 }

[patch, libfortran] Fix PR 34980

[Thomas Koenig]

Hello world,

this fixes PR 34980, a 4.3 regression.

In the PR, there is a comment from Tobias B. with an alternate approach.
I was already into testing my patch when I read that comment, which is
why I didn't pursue that approach further.  I have to admit that I feel
better about adding something that's obviously (to me) correct to a
library function than to do this in the front end.

Regression-tested on i686-pc-linux-gnu.  OK for trunk?

Thomas

2008-01-27  Thomas Koenig  <[EMAIL PROTECTED]>

PR libfortran/34980
* m4/shape.m4:  If return array is empty, return early.
* generated/shape_i4.c:  Regenerated.
* generated/shape_i8.c:  Regenerated.
* generated/shape_i16.c:  Regenerated.

2008-01-27  Thomas Koenig  <[EMAIL PROTECTED]>

PR libfortran/34980
* gfortran.dg/shape_3.f90:  New test.

Index: m4/shape.m4
===
--- m4/shape.m4	(revision 131874)
+++ m4/shape.m4	(working copy)
@@ -49,6 +49,9 @@ shape_'rtype_kind` ('rtype` * const rest
 
   stride = ret->dim[0].stride;
 
+  if (ret->dim[0].ubound < ret->dim[0].lbound)
+return;
+
   for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
 {
   ret->data[n * stride] =
! { dg-do run }
! PR 34980 - we got a segfault for calling shape
!with a scalar.
program main
  integer :: n
  n = 5
  open(10,status="scratch")
  write (10,*) shape(n)
  close(10,status="delete")
end

Fix PR 34305 - ICE on invalid real array bound

[Thomas Koenig]

Hello world,

this straightforward patch removes an unneeded ICE when
we already had emitted a perfectly valid error message.

OK for trunk?

Thomas

2007-12-16  Thomas Koenig  <[EMAIL PROTECTED]>

PR fortran/34305
* resolve.c (compare_bound):  If either of the types of
the arguments isn't INTEGER, return CMP_UNKNOWN.

2007-12-16  Thomas Koenig  <[EMAIL PROTECTED]>

PR fortran/34305
* gfortran.dg/real_dimension_1.f:  New test case.
Index: resolve.c
===
--- resolve.c	(revision 130913)
+++ resolve.c	(working copy)
@@ -3147,8 +3147,11 @@ compare_bound (gfc_expr *a, gfc_expr *b)
   || b == NULL || b->expr_type != EXPR_CONSTANT)
 return CMP_UNKNOWN;
 
+  /* If either of the types isn't INTEGER, we must have
+ raised an error earlier.  */
+
   if (a->ts.type != BT_INTEGER || b->ts.type != BT_INTEGER)
-gfc_internal_error ("compare_bound(): Bad expression");
+return CMP_UNKNOWN;
 
   i = mpz_cmp (a->value.integer, b->value.integer);
 
! { dg-do compile }
! PR 34305 - make sure there's an error message for specifying a
  program test
  parameter (datasize = 1000) 
  dimension idata (datasize)  ! { dg-error "must be of INTEGER type|must have constant shape" }
  idata (1) = -1
  end