> Le 22 oct. 2018 à 23:00, Thomas Koenig <tkoe...@netcologne.de> 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
>
