I'm surprised this was not reported before, but can't find it in bugzilla. $ cat a6.f90 INTEGER :: I(-1:1,-1:1)=0 WRITE(6,*) LBOUND(TRANSPOSE(I)) END $ ifort a6.f90 && ./a.out 1 1 $ gfortran a6.f90 && ./a.out -1 -1
The same thing is true for all the array manipulation functions: integer :: i(-1:1,-1:1) = 0 integer :: j(-1:2) = 0 ! This is working correctly write(*,*) lbound(i(-1:1,-1:1)), ubound(i(-1:1,-1:1)) write(*,*) lbound(i(:,:)), ubound(i(:,:)) write(*,*) lbound(i(0:,-1:)), ubound(i(0:,-1:)) write(*,*) lbound(i(:0,:1)), ubound(i(:0,:1)) ! None of the following is working write(*,*) lbound(transpose(i)), ubound(transpose(i)) write(*,*) lbound(reshape(i,(/2,2/))), ubound(reshape(i,(/2,2/))) write(*,*) lbound(cshift(i,-1)), ubound(cshift(i,-1)) write(*,*) lbound(eoshift(i,-1)), ubound(eoshift(i,-1)) write(*,*) lbound(spread(i,1,2)), ubound(spread(i,1,2)) write(*,*) lbound(maxloc(i)), ubound(maxloc(i)) write(*,*) lbound(minloc(i)), ubound(minloc(i)) write(*,*) lbound(maxval(i,2)), ubound(maxval(i,2)) write(*,*) lbound(minval(i,2)), ubound(minval(i,2)) write(*,*) lbound(product(i,2)), ubound(product(i,2)) write(*,*) lbound(sum(i,2)), ubound(sum(i,2)) write(*,*) lbound(any(i==1,2)), ubound(any(i==1,2)) write(*,*) lbound(count(i==1,2)), ubound(count(i==1,2)) write(*,*) lbound(matmul(i,i)), ubound(matmul(i,i)) write(*,*) lbound(lbound(i)), ubound(lbound(i)) write(*,*) lbound(ubound(i)), ubound(ubound(i)) write(*,*) lbound(shape(i)), ubound(shape(i)) write(*,*) lbound(pack(i,.true.)), ubound(pack(i,.true.)) write(*,*) lbound(unpack(j,(/.true./),(/2/))), & ubound(unpack(j,(/.true./),(/2/))) write(*,*) lbound(merge(i,i,.true.)), ubound(merge(i,i,.true.)) end The results for all write statements below the second comment are off.
For the TRANSPOSE case, the generated code shows that the {u,l}bounds simply aren't set right: $ cat pr29391.f90 integer :: i(-1:1,-1:1)=0, j(2) j = lbound(transpose(i)) end $ cat pr29391.f90.003t.original MAIN__ () { int4 j[2]; static int4 i[9] = {0, 0, 0, 0, 0, 0, 0, 0, 0}; _gfortran_set_std (70, 127, 0); { int8 S.0; S.0 = 1; while (1) { if (S.0 > 2) goto L.1; else (void) 0; { struct array2_int4 atmp.2; struct array2_int4 parm.1; parm.1.dtype = 266; parm.1.dim[0].lbound = -1; parm.1.dim[0].ubound = 1; parm.1.dim[0].stride = 1; parm.1.dim[1].lbound = -1; parm.1.dim[1].ubound = 1; parm.1.dim[1].stride = 3; parm.1.data = (void *) &i[0]; parm.1.offset = 0; atmp.2.dtype = parm.1.dtype; atmp.2.dim[0].stride = parm.1.dim[1].stride; atmp.2.dim[0].lbound = parm.1.dim[1].lbound; atmp.2.dim[0].ubound = parm.1.dim[1].ubound; atmp.2.dim[1].stride = parm.1.dim[0].stride; atmp.2.dim[1].lbound = parm.1.dim[0].lbound; atmp.2.dim[1].ubound = parm.1.dim[0].ubound; atmp.2.data = parm.1.data; atmp.2.offset = parm.1.offset; j[NON_LVALUE_EXPR <S.0> + -1] = (int4) atmp.2.dim[S.0 - 1].lbound; } S.0 = S.0 + 1; } L.1:; } } The following patch ought to fix it: Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (revision 117560) +++ gcc/fortran/trans-array.c (working copy) @@ -787,11 +787,17 @@ gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_lbound (dest, dest_index), - gfc_conv_descriptor_lbound (src, src_index)); + gfc_index_one_node); gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_ubound (dest, dest_index), - gfc_conv_descriptor_ubound (src, src_index)); + build2 (PLUS_EXPR, gfc_array_index_type, + gfc_index_one_node, + build2 (MINUS_EXPR, gfc_array_index_type, + gfc_conv_descriptor_ubound + (src, src_index), + gfc_conv_descriptor_lbound + (src, src_index)))); if (!loop->to[n]) { One last comment: I'm not sure the stride shouldn't be set to one. The patch above regtests fine, and can compile correctly everything I threw at it, but maybe I have not been clever enough to think of something that would trigger a check on the stride. Paul, could I have your opinion on the patch and the stride question? After you comment, I'll go on designing patches for the other functions.
(In reply to comment #2) > One last comment: I'm not sure the stride shouldn't be set to one. The patch > above regtests fine, and can compile correctly everything I threw at it, but > maybe I have not been clever enough to think of something that would trigger a > check on the stride. Sorry, which stride? The inversion of the strides is what allows MATMUL to do neat thing with a*.b - I think that it's a horrible kludge but there we are. It is more efficient and I nearly bust myself getting MATMUL right! > > Paul, could I have your opinion on the patch and the stride question? After you > comment, I'll go on designing patches for the other functions. Don't nest the build2's like that - use a temporary; you might find that fold_build2 gives a better account of itself for index calculations; cf the discussion on the list about the loop reverser for the scalarizer. Ar you sure that this renormalization of the bounds is required? After all: (i) indices should always be realtive to lbound, whatever it is; and (ii) why would anybody be interested to do this? After all, the temporary could be assigned to a variable with any lbound at all. Paul
(In reply to comment #3) > Are you sure that this renormalization of the bounds is required? After all: > (i) indices should always be realtive to lbound, whatever it is; and > (ii) why would anybody be interested to do this? After all, the temporary > could be assigned to a variable with any lbound at all. I'm not sure I understand. The following code: INTEGER :: I(-1:1,-1:1)=0 WRITE(6,*) LBOUND(I) WRITE(6,*) LBOUND(I(:,:)) WRITE(6,*) LBOUND(TRANSPOSE(I)) END ought to output -1 -1 1 1 1 1 and not like we currently do: -1 -1 1 1 -1 -1 That's because of F95 13.14.53: Case (i): For an array section or for an array expression other than a whole array or array structure component, LBOUND(ARRAY, DIM) has the value 1. For a whole array or array structure component, LBOUND(ARRAY, DIM) has the value: (a) equal to the lower bound for subscript DIM of ARRAY if dimension DIM of ARRAY does not have extent zero or if ARRAY is an assumed-size array of rank DIM, or (b) 1 otherwise.
Subject: Re: LBOUND(TRANSPOSE(I)) doesn't work FX, > >That's because of F95 13.14.53: > >Case (i): For an array section or for an array expression other than a whole >array or array structure component, LBOUND(ARRAY, DIM) has the value 1. For a >whole array or array structure component, LBOUND(ARRAY, DIM) has the value: > (a) equal to the lower bound for subscript DIM of ARRAY if dimension DIM of >ARRAY does not have extent zero or if ARRAY is an assumed-size array of rank >DIM, or > (b) 1 otherwise. > > > > That's what I was asking. OK, we have a problem with allocatable components too. Cheers Paul
With the following patch: Index: trans-array.c =================================================================== --- trans-array.c (revision 117560) +++ trans-array.c (working copy) @@ -661,10 +661,12 @@ gfc_add_modify_expr (pre, tmp, size); tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]); - gfc_add_modify_expr (pre, tmp, gfc_index_zero_node); + gfc_add_modify_expr (pre, tmp, gfc_index_one_node); tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]); - gfc_add_modify_expr (pre, tmp, loop->to[n]); + gfc_add_modify_expr (pre, tmp, + fold_build2 (PLUS_EXPR, gfc_array_index_type, + loop->to[n], gfc_index_one_node)); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, loop->to[n], gfc_index_one_node); @@ -787,11 +789,17 @@ gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_lbound (dest, dest_index), - gfc_conv_descriptor_lbound (src, src_index)); + gfc_index_one_node); gfc_add_modify_expr (&se->pre, gfc_conv_descriptor_ubound (dest, dest_index), - gfc_conv_descriptor_ubound (src, src_index)); + fold_build2 (PLUS_EXPR, gfc_array_index_type, + gfc_index_one_node, + fold_build2 (MINUS_EXPR, gfc_array_index_type, + gfc_conv_descriptor_ubound + (src, src_index), + gfc_conv_descriptor_lbound + (src, src_index)))); if (!loop->to[n]) { I get all intrinsics that work through temporaries working right: integer :: i(-1:1,-1:1) = 0 integer :: j(-1:2) = 0 ! Was already working write(*,*) lbound(i(-1:1,-1:1)), ubound(i(-1:1,-1:1)) write(*,*) lbound(i(:,:)), ubound(i(:,:)) write(*,*) lbound(i(0:,-1:)), ubound(i(0:,-1:)) write(*,*) lbound(i(:0,:1)), ubound(i(:0,:1)) ! Fixed write(*,*) lbound(transpose(i)), ubound(transpose(i)) write(*,*) lbound(reshape(i,(/2,2/))), ubound(reshape(i,(/2,2/))) write(*,*) lbound(cshift(i,-1)), ubound(cshift(i,-1)) write(*,*) lbound(eoshift(i,-1)), ubound(eoshift(i,-1)) write(*,*) lbound(spread(i,1,2)), ubound(spread(i,1,2)) write(*,*) lbound(maxloc(i)), ubound(maxloc(i)) write(*,*) lbound(minloc(i)), ubound(minloc(i)) write(*,*) lbound(maxval(i,2)), ubound(maxval(i,2)) write(*,*) lbound(minval(i,2)), ubound(minval(i,2)) write(*,*) lbound(any(i==1,2)), ubound(any(i==1,2)) write(*,*) lbound(count(i==1,2)), ubound(count(i==1,2)) write(*,*) lbound(merge(i,i,.true.)), ubound(merge(i,i,.true.)) write(*,*) lbound(lbound(i)), ubound(lbound(i)) write(*,*) lbound(ubound(i)), ubound(ubound(i)) write(*,*) lbound(shape(i)), ubound(shape(i)) ! Still not working write(*,*) lbound(product(i,2)), ubound(product(i,2)) write(*,*) lbound(sum(i,2)), ubound(sum(i,2)) write(*,*) lbound(matmul(i,i)), ubound(matmul(i,i)) write(*,*) lbound(pack(i,.true.)), ubound(pack(i,.true.)) write(*,*) lbound(unpack(j,(/.true./),(/2/))), & ubound(unpack(j,(/.true./),(/2/))) end So I only have PRODUCT, SUM, MATMUL, PACK and UNPACK to work on.
(In reply to comment #6) Forget that patch, it's breaking lots of things :(
Subject: Re: LBOUND(TRANSPOSE(I)) doesn't work FX, >I get all intrinsics that work through temporaries working right: > > > Great! >So I only have PRODUCT, SUM, MATMUL, PACK and UNPACK to work on. > > > > I wonder if doing the same in trans-intrinsic.c (gfc_conv_intrinsic_function) might not be the magic bullet? You could write a little function to normalise the bounds of se->expr, putting the code in the se->post, and call it from lines 3198 and 3589. You had better check the performance hit, if any, that results from touching gfc_trans_create_temp_array - run the Polyhedron suite, for example, with and without the patch. Paul
Created attachment 12416 [details] Patch for LBOUND/UBOUND This patch fixes this bug completely. It builds fine, regtest and works fine with a few other extra examples that I'll add as testcases. The idea behind it is explained here: http://gcc.gnu.org/ml/fortran/2006-10/msg00379.html
Created attachment 12417 [details] New patch This updated patch is the result of re-reading the Standard about assumed-size arrays.
Subject: Re: LBOUND(TRANSPOSE(I)) doesn't work FX ! if (upper) ! { ! cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound); ! cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound); ! cond3 = fold_build2 (GT_EXPR, boolean_type_node, stride, ! gfc_index_zero_node); ! ! cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1); ! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond2); ! ! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ! ubound, gfc_index_zero_node); ! } ! else ! { ! tree cond1, cond2, cond3; Repeated declaration ! ! if (as->type == AS_ASSUMED_SIZE) ! cond = fold_build2 (EQ_EXPR, boolean_type_node, bound, ! build_int_cst (TREE_TYPE (bound), ! arg->expr->rank)); ! else ! cond = boolean_false_node; ! ! cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound); ! cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound); ! cond3 = fold_build2 (GT_EXPR, boolean_type_node, stride, ! gfc_index_zero_node); Same assignment for upper and lower - put it before the if ! cond1 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1); ! cond1 = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond1, cond2); ! ! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond1); ! ! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ! lbound, gfc_index_one_node); ! } I have tested the above corrections, verified the logic and regtested the patch right now. My version of the diff is attached. I added a comment that consists of the appropriate extracts from the standard. gfortran and ifort now agree on the testcase in #1, whilst g95 differs on the last line. With an appropriate testcase and ChangeLog entries, this is OK for trunk. Paul Index: gcc/fortran/trans-intrinsic.c =================================================================== *** gcc/fortran/trans-intrinsic.c (revision 117628) --- gcc/fortran/trans-intrinsic.c (working copy) *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 710,718 **** tree type; tree bound; tree tmp; ! tree cond; gfc_se argse; gfc_ss *ss; int i; arg = expr->value.function.actual; --- 710,722 ---- tree type; tree bound; tree tmp; ! tree cond, cond1, cond2, cond3, size; ! tree ubound; ! tree lbound; gfc_se argse; gfc_ss *ss; + gfc_array_spec * as; + gfc_ref *ref; int i; arg = expr->value.function.actual; *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 773,782 **** } } ! if (upper) ! se->expr = gfc_conv_descriptor_ubound(desc, bound); else ! se->expr = gfc_conv_descriptor_lbound(desc, bound); type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, se->expr); --- 777,883 ---- } } ! ubound = gfc_conv_descriptor_ubound (desc, bound); ! lbound = gfc_conv_descriptor_lbound (desc, bound); ! ! /* Follow any component references. */ ! if (arg->expr->expr_type == EXPR_VARIABLE ! || arg->expr->expr_type == EXPR_CONSTANT) ! { ! as = arg->expr->symtree->n.sym->as; ! for (ref = arg->expr->ref; ref; ref = ref->next) ! { ! switch (ref->type) ! { ! case REF_COMPONENT: ! as = ref->u.c.component->as; ! continue; ! ! case REF_SUBSTRING: ! continue; ! ! case REF_ARRAY: ! { ! switch (ref->u.ar.type) ! { ! case AR_ELEMENT: ! case AR_SECTION: ! case AR_UNKNOWN: ! as = NULL; ! continue; ! ! case AR_FULL: ! break; ! } ! } ! } ! } ! } ! else ! as = NULL; ! ! /* 13.14.53: Result value for LBOUND ! Case (i): For an array section or for an array expression other than a whole ! array or array structure component, LBOUND(ARRAY, DIM) has the value 1. For a ! whole array or array structure component, LBOUND(ARRAY, DIM) has the value: ! (a) equal to the lower bound for subscript DIM of ARRAY if dimension DIM of ! does not have extent zero or if ARRAY is an assumed-size array of rank ! DIM, or ! (b) 1 otherwise...... ! ! 13.14.113: Result value for UBOUND ! Case (i): For an array section or for an array expression other than a whole ! array or array structure component, UBOUND(ARRAY, DIM) has the value equal ! to the number of elements in the given dimension; otherwise, it has a value ! equal to the upper bound for subscript DIM of ARRAY if dimension DIM of ! ARRAY does not have size zero and has value zero if dimension DIM has size ! zero. */ ! ! if (as) ! { ! tree stride = gfc_conv_descriptor_stride (desc, bound); ! cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound); ! cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound); ! cond3 = fold_build2 (GT_EXPR, boolean_type_node, stride, ! gfc_index_zero_node); ! ! if (upper) ! { ! cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1); ! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond2); ! ! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ! ubound, gfc_index_zero_node); ! } ! else ! { ! if (as->type == AS_ASSUMED_SIZE) ! cond = fold_build2 (EQ_EXPR, boolean_type_node, bound, ! build_int_cst (TREE_TYPE (bound), ! arg->expr->rank)); ! else ! cond = boolean_false_node; ! ! cond1 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1); ! cond1 = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond1, cond2); ! ! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond1); ! ! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ! lbound, gfc_index_one_node); ! } ! } else ! { ! if (upper) ! { ! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, ubound, lbound); ! se->expr = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, ! gfc_index_one_node); ! } ! else ! se->expr = gfc_index_one_node; ! } type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, se->expr);
Subject: Bug 29391 Author: fxcoudert Date: Fri Oct 13 12:20:28 2006 New Revision: 117691 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=117691 Log: PR fortran/29391 * trans-intrinsic.c (gfc_conv_intrinsic_bound): Generate correct code for LBOUND and UBOUND intrinsics. * gfortran.dg/bound_2.f90: New test. Added: trunk/gcc/testsuite/gfortran.dg/bound_2.f90 Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/trans-intrinsic.c trunk/gcc/testsuite/ChangeLog
LBOUND and UBOUND also need to be fixed in simplify.c: program fred call jackal (3, 2) contains subroutine jackal (b, c) integer :: b, c integer :: soda(b:c, 1:2) print *, "SIZE = ", size(soda) print *, "LBOUND (soda, DIM) = ", ubound (soda, 1), ubound(soda, 2) print *, "LBOUND (soda) = ", ubound (soda) end subroutine jackal end gives: SIZE = 0 LBOUND (soda, DIM) = 2 2 LBOUND (soda) = 2 0 (from PR29489)
> (from PR29489) > Thanks FX, I forgot all about it. Paul
Subject: Bug 29391 Author: fxcoudert Date: Thu Nov 16 12:25:11 2006 New Revision: 118888 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=118888 Log: PR fortran/29391 PR fortran/29489 * simplify.c (simplify_bound): Fix the simplification of LBOUND/UBOUND intrinsics. * trans-intrinsic.c (simplify_bound): Fix the logic, and remove an erroneous assert. * gcc/testsuite/gfortran.dg/bound_2.f90: Add more checks. * gcc/testsuite/gfortran.dg/bound_3.f90: New test. Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/simplify.c trunk/gcc/fortran/trans-intrinsic.c trunk/gcc/testsuite/ChangeLog trunk/gcc/testsuite/gfortran.dg/bound_2.f90
Subject: Bug 29391 Author: fxcoudert Date: Fri Nov 24 22:25:34 2006 New Revision: 119174 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=119174 Log: PR fortran/29391 PR fortran/29489 * simplify.c (simplify_bound): Fix the simplification of LBOUND/UBOUND intrinsics. * trans-intrinsic.c (simplify_bound): Fix the logic, and remove an erroneous assert. * gfortran.dg/bound_2.f90: New test. * gfortran.dg/bound_3.f90: New test. PR fortran/24285 * io.c (check_format): Allow dollars everywhere in format, and issue a warning. * gfortran.dg/dollar_edit_descriptor-3.f: New test. Added: branches/gcc-4_2-branch/gcc/testsuite/gfortran.dg/dollar_edit_descriptor-3.f - copied unchanged from r118971, trunk/gcc/testsuite/gfortran.dg/dollar_edit_descriptor-3.f Modified: branches/gcc-4_2-branch/gcc/fortran/ChangeLog branches/gcc-4_2-branch/gcc/fortran/io.c branches/gcc-4_2-branch/gcc/fortran/simplify.c branches/gcc-4_2-branch/gcc/fortran/trans-intrinsic.c branches/gcc-4_2-branch/gcc/testsuite/ChangeLog branches/gcc-4_2-branch/gcc/testsuite/gfortran.dg/bound_2.f90
Subject: Bug 29391 Author: fxcoudert Date: Fri Nov 24 22:45:21 2006 New Revision: 119175 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=119175 Log: PR fortran/29391 PR fortran/29489 * simplify.c (simplify_bound): Fix the simplification of LBOUND/UBOUND intrinsics. * trans-intrinsic.c (simplify_bound): Fix the logic, and remove an erroneous assert. PR fortran/29391 * trans-intrinsic.c (gfc_conv_intrinsic_bound): Generate correct code for LBOUND and UBOUND intrinsics. PR fortran/29391 PR fortran/29489 * gfortran.dg/bound_2.f90: New test. * gfortran.dg/bound_3.f90: New test. Added: branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/bound_2.f90 - copied, changed from r117691, trunk/gcc/testsuite/gfortran.dg/bound_2.f90 Modified: branches/gcc-4_1-branch/gcc/fortran/ChangeLog branches/gcc-4_1-branch/gcc/fortran/simplify.c branches/gcc-4_1-branch/gcc/fortran/trans-intrinsic.c branches/gcc-4_1-branch/gcc/testsuite/ChangeLog
Fixed.