Re: [patch, fortran] Implement FINDLOC

2018-10-28 Thread Thomas Koenig

Hi Paul,


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


I have corrected those.


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


Re: [patch, fortran] Implement FINDLOC

2018-10-28 Thread 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


On Tue, 23 Oct 2018 at 22:03, Thomas Koenig  wrote:
>
> Am 23.10.18 um 18:16 schrieb Dominique d'Humières:
> >
>
> >> 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
>
> > 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
>
> Ah, I didn't include the newly generated files in the previous patch.
> Now included.
>
>
> > 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



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: [patch, fortran] Implement FINDLOC

2018-10-27 Thread Thomas Koenig

Am 23.10.18 um 23:02 schrieb Thomas Koenig:


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


Ping ** 0.571428 ?



Re: [patch, fortran] Implement FINDLOC

2018-10-23 Thread Thomas Koenig

Am 23.10.18 um 18:16 schrieb Dominique d'Humières:





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



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


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



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
! { dg-do compile }
! Test errors in findloc.
program main
  integer, dimension(4) :: a
  logical, dimension(3) :: msk
  a = [2,4,6,8]
  print *,findloc(a) ! { dg-error "Missing actual argument" }
  print *,findloc(a,value=.true.) ! { dg-error "must be in type conformance to argument" }
  print *,findloc(a,23,dim=6) ! { dg-error "is not a valid dimension index" }
  print *,findloc(a,-42,dim=2.0) ! { dg-error "must be INTEGER" }
  print *,findloc(a,6,msk) ! { dg-error "Different shape for arguments 'array' and 'mask'" }
  print *,findloc(a,6,kind=98) ! { dg-error "Invalid kind for INTEGER" }
end program main
! { dg-do run }
! Various tests with findloc.
program main
  implicit none
  real, dimension(2,2) :: a, b
  integer, dimension(2,3) :: c
  logical, dimension(2,2) :: lo
  integer, dimension(:), allocatable :: e
  a = reshape([1.,2.,3.,4.], shape(a))
  b = reshape([1.,2.,1.,2.], shape(b))

  lo = .true.

  if (any(findloc(a, 5.) /= [0,0])) stop 1
  if (any(findloc(a, 5., back=.true.) /= [0,0])) stop 2
  if (any(findloc(a, 2.) /= [2,1])) stop 2
  if (any(findloc(a, 2. ,back=.true.) /= [2,1])) stop 3

  if (any(findloc(a,3.,mask=lo) /= [1,2])) stop 4
  if (any(findloc(a,3,mask=.true.) /= [1,2])) stop 5
  lo(1,2) = .false.
  if (any(findloc(a,3.,mask=lo) /= [0,0])) stop 6
  if (any(findloc(b,2.) /= [2,1])) stop 7
  if (any(findloc(b,2.,back=.true.) /= [2,2])) stop 8
  if (any(findloc(b,1.,mask=lo,back=.true.) /= [1,1])) stop 9
  if (any(findloc(b,1.,mask=.false.) /= [0,0])) stop 10

  c = reshape([1,2,2,2,-9,6], shape(c))
  if (any(findloc(c,value=2,dim=1) /= [2,1,0])) stop 11
  if (any(findloc(c,value=2,dim=2) /= [2,1])) stop 12
end program main
! { dg-do run }
! Various tests with findloc with character variables.
program main
  character(len=2) :: a(3,3), c(3,3), d(3,4)
  character(len=3) :: b(3,3)
  integer :: ret(2)
  integer :: i,j
  character(len=3) :: s
  logical :: lo
  logical, dimension(3,4) :: msk
  data a /"11", "21", "31", "12", "22", "32", "13", "23", "33" /
  data b /"11 ", "21 ", "31 ", "12 ", "22 ", "32 ", "13 ", "23 ", "33 " /
  if (any(findloc(a,"11 ") /= [1,1])) stop 1
  ret = findloc(b,"31")
  do j=1,3
 do i=1,3
write(unit=s,fmt='(2I1," ")') i,j
ret = findloc(b,s)
if (b(ret(1),ret(2)) /= s) stop 2
 end do
  end do

  if (any(findloc(b(::2,::2),"13") /= [1,2])) stop 3

  do j=1,3
do i=1,3
  write(unit=c(i,j),fmt='(I2)') 2+i-j
end do
  end do

  if (any(findloc(c," 1") /= [1,2])) stop 4
  if (any(findloc(c," 1", back=.true.) /= [2,3])) stop 5
  if (any(findloc(c," 1", back=.true., mask=.false.) /= [0,0])) stop 6

  lo = .true.
  if (any(findloc(c," 2", dim=1) /= [1,2,3])) stop 7
  if (any(findloc(c," 2",dim=1,mask=lo) /= [1,2,3])) stop 8

  if (any(findloc(c," 2", dim=1,back=.true.) /= [1,2,3])) stop 9
  if (any(findloc(c," 2",dim=1,mask=lo,back=.true.) /= [1,2,3])) stop 10
  do j=1,4
 do i=1,3
if (j<= i) then
   d(i,j) = "AA"
else
   d(i,j) 

Re: [patch, fortran] Implement FINDLOC

2018-10-23 Thread Dominique d'Humières



> Le 22 oct. 2018 à 23:00, Thomas Koenig  a écrit :
> 
> Hi Dominique,
> 
>> 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

> 
> 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

>  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
> 



Re: [patch, fortran] Implement FINDLOC

2018-10-22 Thread Bernhard Reutner-Fischer
On Mon, 22 Oct 2018 at 23:01, Thomas Koenig  wrote:

> 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,


Re: [patch, fortran] Implement FINDLOC

2018-10-22 Thread Thomas Koenig

Hi Dominique,


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



p15.diff.gz
Description: application/gzip
! { dg-do compile }
! Test errors in findloc.
program main
  integer, dimension(4) :: a
  logical, dimension(3) :: msk
  a = [2,4,6,8]
  print *,findloc(a) ! { dg-error "Missing actual argument" }
  print *,findloc(a,value=.true.) ! { dg-error "must be in type conformance to argument" }
  print *,findloc(a,23,dim=6) ! { dg-error "is not a valid dimension index" }
  print *,findloc(a,-42,dim=2.0) ! { dg-error "must be INTEGER" }
  print *,findloc(a,6,msk) ! { dg-error "Different shape for arguments 'array' and 'mask'" }
  print *,findloc(a,6,kind=98) ! { dg-error "Invalid kind for INTEGER" }
end program main
! { dg-do run }
! Various tests with findloc.
program main
  implicit none
  real, dimension(2,2) :: a, b
  integer, dimension(2,3) :: c
  logical, dimension(2,2) :: lo
  integer, dimension(:), allocatable :: e
  a = reshape([1.,2.,3.,4.], shape(a))
  b = reshape([1.,2.,1.,2.], shape(b))

  lo = .true.

  if (any(findloc(a, 5.) /= [0,0])) stop 1
  if (any(findloc(a, 5., back=.true.) /= [0,0])) stop 2
  if (any(findloc(a, 2.) /= [2,1])) stop 2
  if (any(findloc(a, 2. ,back=.true.) /= [2,1])) stop 3

  if (any(findloc(a,3.,mask=lo) /= [1,2])) stop 4
  if (any(findloc(a,3,mask=.true.) /= [1,2])) stop 5
  lo(1,2) = .false.
  if (any(findloc(a,3.,mask=lo) /= [0,0])) stop 6
  if (any(findloc(b,2.) /= [2,1])) stop 7
  if (any(findloc(b,2.,back=.true.) /= [2,2])) stop 8
  if (any(findloc(b,1.,mask=lo,back=.true.) /= [1,1])) stop 9
  if (any(findloc(b,1.,mask=.false.) /= [0,0])) stop 10

  c = reshape([1,2,2,2,-9,6], shape(c))
  if (any(findloc(c,value=2,dim=1) /= [2,1,0])) stop 11
  if (any(findloc(c,value=2,dim=2) /= [2,1])) stop 12
end program main
! { dg-do run }
! Various tests with findloc with character variables.
program main
  character(len=2) :: a(3,3), c(3,3), d(3,4)
  character(len=3) :: b(3,3)
  integer :: ret(2)
  integer :: i,j
  character(len=3) :: s
  logical :: lo
  logical, dimension(3,4) :: msk
  data a /"11", "21", "31", "12", "22", "32", "13", "23", "33" /
  data b /"11 ", "21 ", "31 ", "12 ", "22 ", "32 ", "13 ", "23 ", "33 " /
  if (any(findloc(a,"11 ") /= [1,1])) stop 1
  ret = findloc(b,"31")
  do j=1,3
 do i=1,3
write(unit=s,fmt='(2I1," ")') i,j
ret = findloc(b,s)
if (b(ret(1),ret(2)) /= s) stop 2
 end do
  end do

  if (any(findloc(b(::2,::2),"13") /= [1,2])) stop 3

  do j=1,3
do i=1,3
  write(unit=c(i,j),fmt='(I2)') 2+i-j
end do
  end do

  if (any(findloc(c," 1") /= [1,2])) stop 4
  if (any(findloc(c," 1", back=.true.) /= [2,3])) stop 5
  if (any(findloc(c," 1", back=.true., mask=.false.) /= [0,0])) stop 6

  lo = .true.
  if (any(findloc(c," 2", dim=1) /= [1,2,3])) stop 7
  if (any(findloc(c," 2",dim=1,mask=lo) /= [1,2,3])) stop 8

  if (any(findloc(c," 2", dim=1,back=.true.) /= [1,2,3])) stop 9
  if (any(findloc(c," 2",dim=1,mask=lo,back=.true.) /= [1,2,3])) stop 10
  do j=1,4
 do i=1,3
if (j<= i) then
   d(i,j) = "AA"
else
   d(i,j) = "BB"
end if
 end do
  end do
  print '(4A3)', transpose(d)
  if (any(findloc(d,"AA") /= [1,1])) stop 11
  if (any(findloc(d,"BB") /= [1,2])) stop 12
  msk = .true.
  if (any(findloc(d,"AA", mask=msk) /= [1,1])) stop 11
  if (any(findloc(d,"BB", mask=msk) /= [1,2])) stop 12
  if (any(findloc(d,"AA", dim=1) /= [1,2,3,0])) stop 13
  if (any(findloc(d,"BB", dim=1) /= [0,1,1,1])) stop 14
  if (any(findloc(d,"AA", dim=2) /= [1,1,1])) stop 15
  if (any(findloc(d,"BB", dim=2) /= [2,3,4])) stop 16
  if (any(findloc(d,"AA", dim=1,mask=msk) /= [1,2,3,0])) stop 17
  if (any(findloc(d,"BB", dim=1,mask=msk) /= [0,1,1,1])) stop 18
  if (any(findloc(d,"AA", dim=2,mask=msk) /= [1,1,1])) stop 19
  if (any(findloc(d,"BB", dim=2,mask=msk) /= [2,3,4])) stop 20

  if (any(findloc(d,"AA", dim=1, back=.true.) /= [3,3,3,0])) stop 21
  if (any(findloc(d,"AA", dim=1, back=.true., mask=msk) /= [3,3,3,0])) stop 22
  if (any(findloc(d,"BB", dim=2, back=.true.) /= [4,4,4])) stop 23
  if (any(findloc(d,"BB", dim=2, back=.true.,mask=msk) /= [4,4,4])) stop 24

  msk(1,:) = .false.
  print '(4L3)', transpose(msk)
  if (any(findloc(d,"AA", dim=1,mask=msk) /= [2,2,3,0])) stop 21
  if (any(findloc(d,"BB", dim=2,mask=msk) /= [0,3,4])) stop 22
  if (any(findloc(d,"AA", dim=2, mask=msk, back=.true.) /= [0,2,3])) stop 23
  if (any(findloc(d,"AA", dim=1, mask=msk, back=.true.) /= [3,3,3,0])) stop 24

end program main
!

Re: [patch, fortran] Implement FINDLOC

2018-10-21 Thread 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: 0x000100037e44 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_init_expr_arguments(e=0x00014c34bd80) at expr.c:2374
frame #899972: 0x000100037e24 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_conversion(e=0x00014c34bd80)
frame #899973: 0x000100037e1d 
f951`gfc_check_init_expr(e=0x00014c34bd80)
frame #899974: 0x000100037e44 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_init_expr_arguments(e=0x00014c34bc40) at expr.c:2374
frame #899975: 0x000100037e24 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_conversion(e=0x00014c34bc40)
frame #899976: 0x000100037e1d 
f951`gfc_check_init_expr(e=0x00014c34bc40)
frame #899977: 0x000100037e44 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_init_expr_arguments(e=0x00014c34bb00) at expr.c:2374
frame #899978: 0x000100037e24 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_conversion(e=0x00014c34bb00)
frame #899979: 0x000100037e1d 
f951`gfc_check_init_expr(e=0x00014c34bb00)
frame #899980: 0x000100037e44 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_init_expr_arguments(e=0x00014c34b9c0) at expr.c:2374
frame #899981: 0x000100037e24 f951`gfc_check_init_expr(gfc_expr*) 
[inlined] check_conversion(e=0x00014c34b9c0)
frame #899982: 0x000100037e1d 
f951`gfc_check_init_expr(e=0x00014c34b9c0)

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

Fwd: [patch, fortran] Implement FINDLOC

2018-10-21 Thread Thomas Koenig

Hi,

again rejected due to being overly large...

The whole message can be found at

https://gcc.gnu.org/ml/fortran/2018-10/msg00102.html

 Weitergeleitete Nachricht 
Betreff: [patch, fortran] Implement FINDLOC
Datum: Sun, 21 Oct 2018 19:36:35 +0200
Von: Thomas Koenig 
An: fort...@gcc.gnu.org , gcc-patches 



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  

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  

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: Regene