From: Thomas Koenig <tkoenig@netcologne.de>
To: "fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [patch, fortran] Implement maxloc and minloc for character
Date: Sun, 19 Nov 2017 22:04:00 -0000 [thread overview]
Message-ID: <44c7b39b-d849-e31a-7175-80bf1a348908@netcologne.de> (raw)
[-- Attachment #1: Type: text/plain, Size: 4159 bytes --]
Hello world,
the attached patch implements maxloc and minloc, a missing feature / bug
(now that we are shooting for f2003 compliance). I decided to do
everything on the library side, since I am more familiar with that
territory. I also suspect that any performance gain from inlining will
be less pronounced than with intrinsic types.
There is one question regarding the ABI. Apparently, the string length
is passed as an int even on a 64-bit system. I verified that this
is indeed the case by doing the actual work on a
powerpc64-unknown-linux-gnu box (gcc110 on the gcc compile farm),
which is big-endian. If we were actually passing an eight-byte
quantity, and only getting the upper bytes, we would crash & burn.
Now, I _thought_ we were passing string lengths as size_t now (Janne?),
but maybe something was missing in that change.
So, this works, and passes regression testing. OK for trunk?
If so, I would tackle maxval next, in a similar fashion.
If anybody has another resolution for the size_t vs. int issue - the
nice thing about m4 is that it is fairly easy to make that change.
Regards
Thomas
2017-11-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
* Makefile.in: Regenerated.
* generated/maxloc0_16_s1.c: New file.
* generated/maxloc0_16_s4.c: New file.
* generated/maxloc0_4_s1.c: New file.
* generated/maxloc0_4_s4.c: New file.
* generated/maxloc0_8_s1.c: New file.
* generated/maxloc0_8_s4.c: New file.
* generated/maxloc1_16_s1.c: New file.
* generated/maxloc1_16_s4.c: New file.
* generated/maxloc1_4_s1.c: New file.
* generated/maxloc1_4_s4.c: New file.
* generated/maxloc1_8_s1.c: New file.
* generated/maxloc1_8_s4.c: New file.
* generated/maxloc2_16_s1.c: New file.
* generated/maxloc2_16_s4.c: New file.
* generated/maxloc2_4_s1.c: New file.
* generated/maxloc2_4_s4.c: New file.
* generated/maxloc2_8_s1.c: New file.
* generated/maxloc2_8_s4.c: New file.
* generated/minloc0_16_s1.c: New file.
* generated/minloc0_16_s4.c: New file.
* generated/minloc0_4_s1.c: New file.
* generated/minloc0_4_s4.c: New file.
* generated/minloc0_8_s1.c: New file.
* generated/minloc0_8_s4.c: New file.
* generated/minloc1_16_s1.c: New file.
* generated/minloc1_16_s4.c: New file.
* generated/minloc1_4_s1.c: New file.
* generated/minloc1_4_s4.c: New file.
* generated/minloc1_8_s1.c: New file.
* generated/minloc1_8_s4.c: New file.
* generated/minloc2_16_s1.c: New file.
* generated/minloc2_16_s4.c: New file.
* generated/minloc2_4_s1.c: New file.
* generated/minloc2_4_s4.c: New file.
* generated/minloc2_8_s1.c: New file.
* generated/minloc2_8_s4.c: New file.
* m4/iforeach-s.m4: New file.
* m4/ifunction-s.m4: New file.
* m4/maxloc0s.m4: New file.
* m4/maxloc1s.m4: New file.
* m4/maxloc2s.m4: New file.
* m4/minloc0s.m4: New file.
* m4/minloc1s.m4: New file.
* m4/minloc2s.m4: New file.
* gfortran.map: Add new functions.
* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.
2017-11-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* check.c (int_or_real_or_char_check_f2003): New function.
* iresolve.c (gfc_resolve_maxloc): Add number "2" for
character arguments and rank-zero return value.
(gfc_resolve_minloc): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
character arguments and rank-zero return value by removing
unneeded arguments and calling the library function.
2017-11-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* gfortran.dg/maxloc_string_1.f90: New test.
* gfortran.dg/minloc_string_1.f90: New test.
[-- Attachment #2: p7.diff.gz --]
[-- Type: application/gzip, Size: 25461 bytes --]
[-- Attachment #3: maxloc_string_1.f90 --]
[-- Type: text/x-fortran, Size: 2142 bytes --]
! { dg-do run }
! Test maxloc for strings for different code paths
program main
implicit none
integer, parameter :: n=4
character(len=4), dimension(n,n) :: c
integer, dimension(n,n) :: a
integer, dimension(2) :: res1, res2
real, dimension(n,n) :: r
logical, dimension(n,n) :: amask
logical(kind=8) :: smask
integer :: i,j
integer, dimension(n) :: q1, q2
character(len=4,kind=4), dimension(n,n) :: c4
character(len=4), dimension(n*n) :: e
integer, dimension(n*n) :: f
logical, dimension(n*n) :: cmask
call random_number (r)
a = int(r*100)
do j=1,n
do i=1,n
write (unit=c(i,j),fmt='(I4.4)') a(i,j)
write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
end do
end do
res1 = maxloc(c)
res2 = maxloc(a)
if (any(res1 /= res2)) call abort
res1 = maxloc(c4)
if (any(res1 /= res2)) call abort
amask = a < 50
res1 = maxloc(c,mask=amask)
res2 = maxloc(a,mask=amask)
if (any(res1 /= res2)) call abort
amask = .false.
res1 = maxloc(c,mask=amask)
if (any(res1 /= 0)) call abort
amask(2,3) = .true.
res1 = maxloc(c,mask=amask)
if (any(res1 /= [2,3])) call abort
res1 = maxloc(c,mask=.false.)
if (any(res1 /= 0)) call abort
res2 = maxloc(a)
res1 = maxloc(c,mask=.true.)
if (any(res1 /= res2)) call abort
q1 = maxloc(c, dim=1)
q2 = maxloc(a, dim=1)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2)
q2 = maxloc(a, dim=2)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=1, mask=amask)
q2 = maxloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2, mask=amask)
q2 = maxloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
amask = a < 50
q1 = maxloc(c, dim=1, mask=amask)
q2 = maxloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2, mask=amask)
q2 = maxloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
e = reshape(c, shape(e))
f = reshape(a, shape(f))
if (maxloc(e,dim=1) /= maxloc(f,dim=1)) call abort
cmask = .false.
if (maxloc(e,dim=1,mask=cmask) /= 0) call abort
cmask = f > 50
if ( maxloc(e, dim=1, mask=cmask) /= maxloc (f, dim=1, mask=cmask)) call abort
end program main
[-- Attachment #4: minloc_string_1.f90 --]
[-- Type: text/x-fortran, Size: 2142 bytes --]
! { dg-do run }
! Test minloc for strings for different code paths
program main
implicit none
integer, parameter :: n=4
character(len=4), dimension(n,n) :: c
integer, dimension(n,n) :: a
integer, dimension(2) :: res1, res2
real, dimension(n,n) :: r
logical, dimension(n,n) :: amask
logical(kind=8) :: smask
integer :: i,j
integer, dimension(n) :: q1, q2
character(len=4,kind=4), dimension(n,n) :: c4
character(len=4), dimension(n*n) :: e
integer, dimension(n*n) :: f
logical, dimension(n*n) :: cmask
call random_number (r)
a = int(r*100)
do j=1,n
do i=1,n
write (unit=c(i,j),fmt='(I4.4)') a(i,j)
write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
end do
end do
res1 = minloc(c)
res2 = minloc(a)
if (any(res1 /= res2)) call abort
res1 = minloc(c4)
if (any(res1 /= res2)) call abort
amask = a < 50
res1 = minloc(c,mask=amask)
res2 = minloc(a,mask=amask)
if (any(res1 /= res2)) call abort
amask = .false.
res1 = minloc(c,mask=amask)
if (any(res1 /= 0)) call abort
amask(2,3) = .true.
res1 = minloc(c,mask=amask)
if (any(res1 /= [2,3])) call abort
res1 = minloc(c,mask=.false.)
if (any(res1 /= 0)) call abort
res2 = minloc(a)
res1 = minloc(c,mask=.true.)
if (any(res1 /= res2)) call abort
q1 = minloc(c, dim=1)
q2 = minloc(a, dim=1)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2)
q2 = minloc(a, dim=2)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=1, mask=amask)
q2 = minloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2, mask=amask)
q2 = minloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
amask = a < 50
q1 = minloc(c, dim=1, mask=amask)
q2 = minloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2, mask=amask)
q2 = minloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
e = reshape(c, shape(e))
f = reshape(a, shape(f))
if (minloc(e,dim=1) /= minloc(f,dim=1)) call abort
cmask = .false.
if (minloc(e,dim=1,mask=cmask) /= 0) call abort
cmask = f > 50
if ( minloc(e, dim=1, mask=cmask) /= minloc (f, dim=1, mask=cmask)) call abort
end program main
next reply other threads:[~2017-11-19 21:11 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-11-19 22:04 Thomas Koenig [this message]
2017-11-20 8:41 ` Janne Blomqvist
2017-11-20 18:33 ` Thomas Koenig
2017-11-21 16:25 ` Janne Blomqvist
2017-11-21 19:53 ` Thomas Koenig
2017-11-21 20:47 ` Janne Blomqvist
2017-11-22 18:16 ` Thomas Koenig
2017-11-23 13:25 ` Janne Blomqvist
2017-11-23 14:03 ` Janne Blomqvist
2017-11-23 14:06 ` Ramana Radhakrishnan
2017-11-23 14:10 ` Janne Blomqvist
2017-11-23 18:40 ` Thomas Koenig
2017-11-24 9:33 ` Janne Blomqvist
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=44c7b39b-d849-e31a-7175-80bf1a348908@netcologne.de \
--to=tkoenig@netcologne.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).