[patch, fortran] Implement FINDLOC

[Thomas Koenig]

Hello world,

here is the implementation of FINDLOC. This is another
step towards full F2008 compliance (we're not that far
away, actually, modulo a few bugs, of course).

This was quite a big piece of work, but at least I ended
up understanding a bit about trans-*.

Regression-tested.

OK for trunk?

Regards

Thomas

2017-10-21 Thomas Koenig <***@gcc.gnu.org>

PR fortran/54613
* gfortran.h (gfc_isym_id): Add GFC_ISYM_FINDLOC.
(gfc_check_f): Add f6fl field.
(gfc_simplify_f): Add f6 field.
(gfc_resolve_f): Likewise.
(gfc_type_letter): Add optional logical_equas_int flag.
* check.c (intrinsic_type_check): New function.
(gfc_check_findloc): New function.
* intrinsics.c (gfc_type_letter): If logical_equals_int is
set, act accordingly.
(add_sym_5ml): Reformat comment.
(add_sym_6fl): New function.
(add_functions): Add findloc.
(check_arglist): Add sixth argument, handle it.
(resolve_intrinsic): Likewise.
(check_specific): Handle findloc.
* intrinsic.h (gfc_check_findloc): Add prototype.
(gfc_simplify_findloc): Likewise.
(gfc_resolve_findloc): Likewise.
(MAX_INTRINSIC_ARGS): Adjust.
* iresolve.c (gfc_resolve_findloc): New function.
* simplify.c (gfc_simplify_minmaxloc): Make static.
(simplify_findloc_to_scalar): New function.
(simplify_findloc_nodim): New function.
(simplify_findloc_to_array): New function.
(gfc_simplify_findloc): New function.
(gfc_conv_intrinsic_findloc): New function.
(gfc_conv_intrinsic_function): Handle GFC_ISYM_FINDLOC.
(gfc_is_intrinsic_libcall): Likewise.

2017-10-21 Thomas Koenig <***@gcc.gnu.org>

PR fortran/54613
* Makefile.am: Add files for findloc.
* Makefile.in: Regenerated.
* libgfortran.h (gfc_array_index_type): Add.
(gfc_array_s1): Add using GFC_UINTEGER_1.
(gfc_array_s4): Likewise.
Replace unnecessary comment.
(HAVE_GFC_UINTEGER_1): Define.
(HAVE_GFC_UINTEGER_4): Define.
* m4/findloc0.m4: New file.
* m4/findloc0s.m4: New file.
* m4/findloc1.m4: New file.
* m4/findloc1s.m4: New file.
* m4/findloc2s.m4: New file.
* m4/ifindloc0.m4: New file.
* m4/ifindloc1.m4: New file.
* m4/ifindloc2.m4: New file.
* m4/iparm.m4: Use unsigned integer for characters.
* generated/findloc0_c16.c: New file.
* generated/findloc0_c4.c: New file.
* generated/findloc0_c8.c: New file.
* generated/findloc0_i1.c: New file.
* generated/findloc0_i16.c: New file.
* generated/findloc0_i2.c: New file.
* generated/findloc0_i4.c: New file.
* generated/findloc0_i8.c: New file.
* generated/findloc0_r16.c: New file.
* generated/findloc0_r4.c: New file.
* generated/findloc0_r8.c: New file.
* generated/findloc0_s1.c: New file.
* generated/findloc0_s4.c: New file.
* generated/findloc1_c16.c: New file.
* generated/findloc1_c4.c: New file.
* generated/findloc1_c8.c: New file.
* generated/findloc1_i1.c: New file.
* generated/findloc1_i16.c: New file.
* generated/findloc1_i2.c: New file.
* generated/findloc1_i4.c: New file.
* generated/findloc1_i8.c: New file.
* generated/findloc1_r16.c: New file.
* generated/findloc1_r4.c: New file.
* generated/findloc1_r8.c: New file.
* generated/findloc1_s1.c: New file.
* generated/findloc1_s4.c: New file.
* generated/findloc2_s1.c: New file.
* generated/findloc2_s4.c: New file.
* generated/maxloc0_16_s1.c: Regenerated.
* generated/maxloc0_16_s4.c: Regenerated.
* generated/maxloc0_4_s1.c: Regenerated.
* generated/maxloc0_4_s4.c: Regenerated.
* generated/maxloc0_8_s1.c: Regenerated.
* generated/maxloc0_8_s4.c: Regenerated.
* generated/maxloc1_16_s1.c: Regenerated.
* generated/maxloc1_16_s4.c: Regenerated.
* generated/maxloc1_4_s1.c: Regenerated.
* generated/maxloc1_4_s4.c: Regenerated.
* generated/maxloc1_8_s1.c: Regenerated.
* generated/maxloc1_8_s4.c: Regenerated.
* generated/maxloc2_16_s1.c: Regenerated.
* generated/maxloc2_16_s4.c: Regenerated.
* generated/maxloc2_4_s1.c: Regenerated.
* generated/maxloc2_4_s4.c: Regenerated.
* generated/maxloc2_8_s1.c: Regenerated.
* generated/maxloc2_8_s4.c: Regenerated.
* generated/maxval0_s1.c: Regenerated.
* generated/maxval0_s4.c: Regenerated.
* generated/maxval1_s1.c: Regenerated.
* generated/maxval1_s4.c: Regenerated.
* generated/minloc0_16_s1.c: Regenerated.
* generated/minloc0_16_s4.c: Regenerated.
* generated/minloc0_4_s1.c: Regenerated.
* generated/minloc0_4_s4.c: Regenerated.
* generated/minloc0_8_s1.c: Regenerated.
* generated/minloc0_8_s4.c: Regenerated.
* generated/minloc1_16_s1.c: Regenerated.
* generated/minloc1_16_s4.c: Regenerated.
* generated/minloc1_4_s1.c: Regenerated.
* generated/minloc1_4_s4.c: Regenerated.
* generated/minloc1_8_s1.c: Regenerated.
* generated/minloc1_8_s4.c: Regenerated.
* generated/minloc2_16_s1.c: Regenerated.
* generated/minloc2_16_s4.c: Regenerated.
* generated/minloc2_4_s1.c: Regenerated.
* generated/minloc2_4_s4.c: Regenerated.
* generated/minloc2_8_s1.c: Regenerated.
* generated/minloc2_8_s4.c: Regenerated.
* generated/minval0_s1.c: Regenerated.
* generated/minval0_s4.c: Regenerated.
* generated/minval1_s1.c: Regenerated.
* generated/minval1_s4.c: Regenerated.

2017-10-21 Thomas Koenig <***@gcc.gnu.org>

PR fortran/54613
* gfortran.dg/findloc_1.f90: New test.
* gfortran.dg/findloc_2.f90: New test.
* gfortran.dg/findloc_3.f90: New test.
* gfortran.dg/findloc_4.f90: New test.
* gfortran.dg/findloc_5.f90: New test.
* gfortran.dg/findloc_6.f90: New test.

[Dominique d'Humières]

Hi Thomas,

With your patch, compiling the following test

program logtest3
implicit none
logical :: x = .true.
integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
back=x)
end program logtest3

gives an ICE

gfc: internal compiler error: Segmentation fault: 11 signal terminated program f951

I see some kind of "infinite" recursion

…
frame #899971: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34bd80) at expr.c:2374
frame #899972: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34bd80)
frame #899973: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34bd80)
frame #899974: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34bc40) at expr.c:2374
frame #899975: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34bc40)
frame #899976: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34bc40)
frame #899977: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34bb00) at expr.c:2374
frame #899978: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34bb00)
frame #899979: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34bb00)
frame #899980: 0x0000000100037e44 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_init_expr_arguments(e=0x000000014c34b9c0) at expr.c:2374
frame #899981: 0x0000000100037e24 f951`gfc_check_init_expr(gfc_expr*) [inlined] check_conversion(e=0x000000014c34b9c0)
frame #899982: 0x0000000100037e1d f951`gfc_check_init_expr(e=0x000000014c34b9c0)

Also in gfortran.dg/findloc_4.f90 should not the lines

print *,findloc(a,value=1.5,dim=2,back=.true.)
print *,findloc(a,value=1,dim=1,mask=lo)

converted to tests?

Thanks for working on the implementation of FINDLOC.

Dominique

[Thomas Koenig]

Hi Dominique,

Post by Dominique d'Humières
With your patch, compiling the following test
program logtest3
implicit none
logical :: x = .true.
integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
back=x)
end program logtest3
gives an ICE

I sometimes wonder where you get all these test cases from...

Anyway, the attached patch fixes this, plus the print *, instead
of test for return values, plus the whitespace issues mentioned
by Bernhard. Patch gzipped this time to let it go through to
gcc-patches.

OK for trunk?

Regards

Thomas

[Bernhard Reutner-Fischer]

Post by Thomas Koenig
Anyway, the attached patch fixes this, plus the print *, instead
of test for return values, plus the whitespace issues mentioned
by Bernhard. Patch gzipped this time to let it go through to
gcc-patches.

Thanks, The few remainin issues are:

$ ./contrib/check_GNU_style.py /tmp/p15.diff
=== ERROR type #1: blocks of 8 spaces should be replaced with tabs (1
error(s)) ===
gcc/fortran/simplify.c:5667:17: dim_index -= 1;████████ /*
zero-base index */

=== ERROR type #2: dot, space, space, end of comment (1 error(s)) ===
gcc/fortran/simplify.c:5667:50: dim_index -= 1; /*
zero-base index */

=== ERROR type #3: dot, space, space, new sentence (3 error(s)) ===
gcc/fortran/check.c:3363:30:/* Check function for findloc.█Mostly like
gfc_check_minloc_maxloc
gcc/fortran/simplify.c:5604:32:/* Simplify findloc to an array.█Similar to
gcc/fortran/simplify.c:5627:27: linked-list traversal.█Masked
elements are set to NULL. */

=== ERROR type #4: lines should not exceed 80 characters (196 error(s)) ===
gcc/fortran/check.c:159:80: gfc_error ("%qs argument of %qs
intrinsic at %L must be of intrinsic type",
gcc/fortran/intrinsic.c:728:80:add_sym_6fl (const char *name,
gfc_isym_id id, enum klass cl, int actual_ok, bt type,
gcc/fortran/simplify.c:5674:80: tmpstride[i] = (i == 0) ? 1 :
tmpstride[i-1] * mpz_get_si (array->shape[i-1]);

=== ERROR type #6: trailing operator (1 error(s)) ===
gcc/fortran/iresolve.c:1873:25: f->value.function.name =

(this wants ...function.name\n = gfc_get_string (... )

=== ERROR type #7: trailing whitespace (2 error(s)) ===
gcc/fortran/check.c:3390:0:███
gcc/fortran/simplify.c:5794:10: else█

TIA,

[Dominique d'Humières]

Post by Thomas Koenig
Hi Dominique,

Post by Dominique d'Humières
With your patch, compiling the following test
program logtest3
implicit none
logical :: x = .true.
integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
back=x)
end program logtest3
gives an ICE

I sometimes wonder where you get all these test cases from…

This is a reduction of a James van Buskirk's test at
https://groups.google.com/forum/?fromgroups=#!topic/comp.lang.fortran/GpaACNKn0Ds

Post by Thomas Koenig
Anyway, the attached patch fixes this,

It now gives the error

4 | integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
| 1
Error: transformational intrinsic 'findloc' at (1) is not permitted in an initialization expression

However a similar test

program logtest3
implicit none
integer, parameter :: A1 = 2
logical, parameter :: L1 = transfer(A1,.FALSE.)
integer, parameter :: I_FINDLOC_MASK(1) = findloc([1,1],1, &
mask=[L1,.TRUE.])
print *, A1, L1, I_FINDLOC_MASK(1)
end program logtest3

compiles and gives ' 2 F 2’ at run time. Also I see several transformational intrinsic accepted as initialization expressions.

The following test

program logtest3
implicit none
! ********************************************************!
! ******* Everything depends on this parameter ***********!

integer, parameter :: A1 = 2
logical :: L
L = transfer(A1,L)
call sub(L)
end program logtest3

subroutine sub(x)
implicit none
logical x
integer a(1)
character(*), parameter :: strings(2) = ['.TRUE. ','.FALSE.']

a = findloc([1,1],1,mask=[x,.TRUE.])
write(*,'(a)') 'Value by FINDLOC(MASK): '// &
trim(strings(a(1)))
a = findloc([1,1],1,back=x)
write(*,'(a)') 'Value by FINDLOC(BACK): '// &
trim(strings(3-a(1)))

end subroutine sub

does not link:

8 | L = transfer(A1,L)
| 1
Warning: Assigning value other than 0 or 1 to LOGICAL has undefined result at (1)
Undefined symbols for architecture x86_64:
"__gfortran_findloc0_i4", referenced from:
_sub_ in ccnoLKfH.o
"__gfortran_mfindloc0_i4", referenced from:
_sub_ in ccnoLKfH.o
ld: symbol(s) not found for architecture x86_64
collect2: error: ld returned 1 exit status

Finally the line before the end of findloc_6.f90 should be

if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23

TIA

Dominique

Post by Thomas Koenig
plus the print *, instead
of test for return values, plus the whitespace issues mentioned
by Bernhard. Patch gzipped this time to let it go through to
gcc-patches.
OK for trunk?
Regards
Thomas

[Thomas Koenig]

Post by Dominique d'Humières

Post by Thomas Koenig
Anyway, the attached patch fixes this,

It now gives the error
4 | integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
| 1
Error: transformational intrinsic 'findloc' at (1) is not permitted in an initialization expression

That error message was misleading, the new one now has

Error: Parameter 'x' at (1) has not been declared or is a variable,
which does not reduce to a constant expression

Post by Dominique d'Humières
The following test
program logtest3
implicit none
! ********************************************************!
! ******* Everything depends on this parameter ***********!
integer, parameter :: A1 = 2
logical :: L
L = transfer(A1,L)
call sub(L)
end program logtest3
subroutine sub(x)
implicit none
logical x
integer a(1)
character(*), parameter :: strings(2) = ['.TRUE. ','.FALSE.']
a = findloc([1,1],1,mask=[x,.TRUE.])
write(*,'(a)') 'Value by FINDLOC(MASK): '// &
trim(strings(a(1)))
a = findloc([1,1],1,back=x)
write(*,'(a)') 'Value by FINDLOC(BACK): '// &
trim(strings(3-a(1)))
end subroutine sub
8 | L = transfer(A1,L)
| 1
Warning: Assigning value other than 0 or 1 to LOGICAL has undefined result at (1)
_sub_ in ccnoLKfH.o
_sub_ in ccnoLKfH.o
ld: symbol(s) not found for architecture x86_64
collect2: error: ld returned 1 exit status

Ah, I didn't include the newly generated files in the previous patch.
Now included.

Post by Dominique d'Humières
Finally the line before the end of findloc_6.f90 should be
if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23

Changed, also the whitespace fixes that Bernhard mentioned.

So, I think this should be clear for trunk now. I will supply
the documentation later.

Regards

Thomas

[Thomas Koenig]

So, I think this should be clear for trunk now.  I will supply
the documentation later.

Ping ** 0.571428 ?

[Paul Richard Thomas]

Hi Thomas,

The patch is ready to go. Please correct the following tiny nits:

s/Check that en expression/Check that an expression/

s/Set this if resolution has already happened and it could be
harmful/Set this if resolution has already happened. It could be
harmful/

An even tinier, probably ignorable one: Why did you break this line?
-/* MINLOC and MAXLOC get special treatment because their argument
- might have to be reordered. */

Many thanks for working on this.

Cheers

Paul

Post by Thomas Koenig

Post by Dominique d'Humières

Post by Thomas Koenig
Anyway, the attached patch fixes this,

It now gives the error
4 | integer, parameter :: I_FINDLOC_BACK(1) = findloc([1,1],1, &
| 1
Error: transformational intrinsic 'findloc' at (1) is not permitted in an initialization expression

That error message was misleading, the new one now has
Error: Parameter 'x' at (1) has not been declared or is a variable,
which does not reduce to a constant expression

Post by Dominique d'Humières
The following test
program logtest3
implicit none
! ********************************************************!
! ******* Everything depends on this parameter ***********!
integer, parameter :: A1 = 2
logical :: L
L = transfer(A1,L)
call sub(L)
end program logtest3
subroutine sub(x)
implicit none
logical x
integer a(1)
character(*), parameter :: strings(2) = ['.TRUE. ','.FALSE.']
a = findloc([1,1],1,mask=[x,.TRUE.])
write(*,'(a)') 'Value by FINDLOC(MASK): '// &
trim(strings(a(1)))
a = findloc([1,1],1,back=x)
write(*,'(a)') 'Value by FINDLOC(BACK): '// &
trim(strings(3-a(1)))
end subroutine sub
8 | L = transfer(A1,L)
| 1
Warning: Assigning value other than 0 or 1 to LOGICAL has undefined result at (1)
_sub_ in ccnoLKfH.o
_sub_ in ccnoLKfH.o
ld: symbol(s) not found for architecture x86_64
collect2: error: ld returned 1 exit status

Ah, I didn't include the newly generated files in the previous patch.
Now included.

Post by Dominique d'Humières
Finally the line before the end of findloc_6.f90 should be
if (findloc(ch,"CC ",dim=1,mask=false) /= 0) stop 23

Changed, also the whitespace fixes that Bernhard mentioned.
So, I think this should be clear for trunk now. I will supply
the documentation later.
Regards
Thomas

[Thomas Koenig]

Hi Paul,
I have corrected those.

Post by Paul Richard Thomas
s/Check that en expression/Check that an expression/
s/Set this if resolution has already happened and it could be
harmful/Set this if resolution has already happened. It could be
harmful/
An even tinier, probably ignorable one: Why did you break this line?
-/* MINLOC and MAXLOC get special treatment because their argument
- might have to be reordered. */

I think I hit M-q in emacs at some stage - I have left it as it is.

Thanks for the review!

Committed as r265570.

Regards

Thomas

[Bernhard Reutner-Fischer]

Post by Thomas Koenig
Hello world,
here is the implementation of FINDLOC. This is another
step towards full F2008 compliance (we're not that far
away, actually, modulo a few bugs, of course).
This was quite a big piece of work, but at least I ended
up understanding a bit about trans-*.
Regression-tested.
OK for trunk?

Can you please watch out for coding-style issues?
See
$ ./contrib/check_GNU_style.py /tmp/findloc.00.patch

I'd ignore the
=== ERROR type #4: lines should not exceed 80 characters (418 error(s)) ===
in libgfortran m4 and generated files, but there spots in gcc/fortran
that should be fixed.

Also there are alot of
=== ERROR type #5: there should be exactly one space between function
name and parenthesis (886 error(s)) ===
which really makes the code hard to read.

TIA,