This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran] Fix PR 19479: Simplification of the {L|U}BOUND intrinsics
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- Cc: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 28 Feb 2005 23:06:07 +0100
- Subject: Re: [gfortran] Fix PR 19479: Simplification of the {L|U}BOUND intrinsics
- References: <4221D06A.8070905@physik.uni-muenchen.de> <20050228204948.GA94557@troutmask.apl.washington.edu>
Thanks,
Steve Kargl wrote:
> The above appears to have whitespace problems.
I have reindented the function, plus added a pair of braces around the
statement in the loop. While looking at this, I realised that
gfc_simplify_bound is a static function, so I removed the 'gfc_' prefix. For
reference I'll attach what I will commit once building & testing finishes.
- Tobi
Index: fortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/ChangeLog,v
retrieving revision 1.339
diff -u -p -r1.339 ChangeLog
--- fortran/ChangeLog 28 Feb 2005 19:59:05 -0000 1.339
+++ fortran/ChangeLog 28 Feb 2005 22:00:02 -0000
@@ -1,3 +1,10 @@
+2005-02-28 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+ (port from g95)
+
+ PR fortran/19479
+ * simplify.c (gfc_simplify_bound): Rename to ...
+ (simplify_bound): ... this and overhaul.
+
2005-02-28 Steven G. Kargl <kargl@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_iargc): remove boolean argument.
Index: fortran/simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.19
diff -u -p -r1.19 simplify.c
--- fortran/simplify.c 19 Feb 2005 20:29:05 -0000 1.19
+++ fortran/simplify.c 28 Feb 2005 22:00:02 -0000
@@ -1766,16 +1766,18 @@ gfc_simplify_kind (gfc_expr * e)
static gfc_expr *
-gfc_simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
+simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
{
gfc_ref *ref;
gfc_array_spec *as;
- int i;
+ gfc_expr *e;
+ int d;
if (array->expr_type != EXPR_VARIABLE)
return NULL;
if (dim == NULL)
+ /* TODO: Simplify constant multi-dimensional bounds. */
return NULL;
if (dim->expr_type != EXPR_CONSTANT)
@@ -1783,29 +1785,66 @@ gfc_simplify_bound (gfc_expr * array, gf
/* Follow any component references. */
as = array->symtree->n.sym->as;
- ref = array->ref;
- while (ref->next != NULL)
+ for (ref = array->ref; ref; ref = ref->next)
+ {
+ switch (ref->type)
+ {
+ case REF_ARRAY:
+ switch (ref->u.ar.type)
+ {
+ case AR_ELEMENT:
+ as = NULL;
+ continue;
+
+ case AR_FULL:
+ /* We're done because 'as' has already been set in the
+ previous iteration. */
+ goto done;
+
+ case AR_SECTION:
+ case AR_UNKNOWN:
+ return NULL;
+ }
+
+ gcc_unreachable ();
+
+ case REF_COMPONENT:
+ as = ref->u.c.component->as;
+ continue;
+
+ case REF_SUBSTRING:
+ continue;
+ }
+ }
+
+ gcc_unreachable ();
+
+ done:
+ if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE)
+ return NULL;
+
+ d = mpz_get_si (dim->value.integer);
+
+ if (d < 1 || d > as->rank
+ || (d == as->rank && as->type == AS_ASSUMED_SIZE && upper))
{
- if (ref->type == REF_COMPONENT)
- as = ref->u.c.sym->as;
- ref = ref->next;
+ gfc_error ("DIM argument at %L is out of bounds", &dim->where);
+ return &gfc_bad_expr;
}
- if (ref->type != REF_ARRAY || ref->u.ar.type != AR_FULL)
+ e = upper ? as->upper[d-1] : as->lower[d-1];
+
+ if (e->expr_type != EXPR_CONSTANT)
return NULL;
-
- i = mpz_get_si (dim->value.integer);
- if (upper)
- return gfc_copy_expr (as->upper[i-1]);
- else
- return gfc_copy_expr (as->lower[i-1]);
+
+ return gfc_copy_expr (e);
}
gfc_expr *
gfc_simplify_lbound (gfc_expr * array, gfc_expr * dim)
{
- return gfc_simplify_bound (array, dim, 0);
+ return simplify_bound (array, dim, 0);
}
@@ -3578,7 +3617,7 @@ gfc_simplify_trim (gfc_expr * e)
gfc_expr *
gfc_simplify_ubound (gfc_expr * array, gfc_expr * dim)
{
- return gfc_simplify_bound (array, dim, 1);
+ return simplify_bound (array, dim, 1);
}
Index: testsuite/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/ChangeLog,v
retrieving revision 1.5098
diff -u -p -r1.5098 ChangeLog
--- testsuite/ChangeLog 28 Feb 2005 19:22:28 -0000 1.5098
+++ testsuite/ChangeLog 28 Feb 2005 22:00:08 -0000
@@ -1,3 +1,8 @@
+2005-02-28 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/19479
+ * gfortran.dg/bound_1.f90: New test.
+
2005-02-28 Joseph S. Myers <joseph@codesourcery.com>
PR c/20245
Index: testsuite/gfortran.dg/bound_1.f90
===================================================================
RCS file: testsuite/gfortran.dg/bound_1.f90
diff -N testsuite/gfortran.dg/bound_1.f90
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ testsuite/gfortran.dg/bound_1.f90 28 Feb 2005 22:00:12 -0000
@@ -0,0 +1,20 @@
+! { dg-do run }
+ implicit none
+
+ type test_type
+ integer, dimension(5) :: a
+ end type test_type
+
+ type (test_type), target :: tt(2)
+ integer i
+
+ i = ubound(tt(1)%a, 1)
+ if (i/=5) call abort()
+ i = lbound(tt(1)%a, 1)
+ if (i/=1) call abort()
+
+ i = ubound(tt, 1)
+ if (i/=2) call abort()
+ i = lbound(tt, 1)
+ if (i/=1) call abort()
+end