https://gcc.gnu.org/bugzilla/show_bug.cgi?id=120049
Jerry DeLisle <jvdelisle at gcc dot gnu.org> changed:
What |Removed |Added
----------------------------------------------------------------------------
Attachment #61307|0 |1
is obsolete| |
--- Comment #30 from Jerry DeLisle <jvdelisle at gcc dot gnu.org> ---
Created attachment 61445
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=61445&action=edit
Preliminary patch showing all the logic
This patch shows all the logic involved. I have some debugging aspects in this
which I will get rid of. Also, I encountered some interesting cases where
trying to return gfc_typename for the error message, the BT_VOID was giving an
internal error. We may want to handle that a bit differently. I also found
that when processing the following test case, issueing an error from one
example can hide the ICE from another. To test these, I would comment all
examples except one, one at a time. It is a bbt laborious. I will finish
dejagnu-ing this test:
! Test the fix for PR120049
program tests_gtk_sup
use gtk_sup
implicit none
type mytype
integer :: myint
end type mytype
type(mytype) :: ijkl = mytype(42)
logical :: truth
real :: var1
type(c_ptr), target :: val
character(15) :: stringy
complex :: certainly
truth = .true.
var1 = 86.
stringy = "what the hay!"
certainly = (3.14,-4.13)
if (c_associated(val, c_loc(val))) then
stop 1
endif
if (c_associated(c_loc(val), val)) then
stop 2
endif
print *, c_associated(c_loc(val), 42)
print *, c_associated(c_loc(val), .42)
print *, c_associated(c_loc(val), truth)
print *, c_associated(c_loc(val), .false.)
print *, c_associated(c_loc(val), var1)
print *, c_associated(c_loc(val), stringy)
print *, c_associated(c_loc(val), certainly)
print *, c_associated(42)
print *, c_associated(.42)
print *, c_associated(truth)
print *, c_associated(.false.)
print *, c_associated(var1)
print *, c_associated(stringy)
print *, c_associated(certainly)
print *, c_associated(.42)
print *, c_associated(val, testit(val))
print *, c_associated(testit(val), val)
print *, c_associated(testit(val))
contains
function testit (avalue) result(res)
type(c_ptr) :: avalue
type(mytype) :: res
res%myint = 42
end function
end program tests_gtk_sup
