Le 17/08/2014 14:46, Dominique Dhumieres a écrit :
>> My knowledge of unlimited polymorphic types is limited, but I think that
>> this is not correct.
>
> My knowledge of unlimited polymorphic types is even more limited,
> then I cannot comment about the correctness of the patch. However
>
>> The new length of the string has to be stored somewhere. If you don't
>> do that, for example the intrinsic len() function won't work.
>
> if I add a line
>
> if (len(P) /= 20) call abort()
>
> in the 'type is (character(*))' block, the test still succeeds.
>
> Dominique
>
Here is a failing testcase.
I must admit it wasn't easy to find, and it's probably at least as much
a bug with select as with allocate.
It seems that for unlimited polymorphic entities, the _size vtable field
is used as character length.
So there is no need to explicitly set the character length as the whole
vtable is overwritten upon allocation. And the patch works.
I don't know how we cope with non-default kind though (which is what the
testcase is about).
Mikael
$ ./unlimited_polymorphic_20
here
there
Program aborted. Backtrace:
#0 0x7FDFBA026B57
#1 0x7FDFBA028272
#2 0x7FDFBA0F3218
#3 0x400E24 in test_sub at unlimited_polymorphic_20.f90:24
(discriminator 1)
#4 0x400C0D in test at unlimited_polymorphic_20.f90:6
Abandon
$
program test
call test_sub
contains
subroutine test_sub
implicit none
class(*), pointer :: P
allocate(character(len=20, kind=4)::P)
select type(P)
type is (character(len=*, kind=4))
print *, "here"
P ="some test string"
if (P .ne. 4_"some test string") then
call abort()
end if
print *, "there"
if (len(P) /= 20) call abort
print *, "not there"
class default
print *, "bah"
call abort()
end select
deallocate(P)
end subroutine test_sub
end program test
