From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 19612 invoked by alias); 18 Apr 2008 08:21:31 -0000 Received: (qmail 19491 invoked by uid 48); 18 Apr 2008 08:20:46 -0000 Date: Fri, 18 Apr 2008 08:21:00 -0000 Subject: [Bug fortran/35971] New: ICE on valid code X-Bugzilla-Reason: CC Message-ID: Reply-To: gcc-bugzilla@gcc.gnu.org To: gcc-bugs@gcc.gnu.org From: "fxcoudert at gcc dot gnu dot org" Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-bugs-owner@gcc.gnu.org X-SW-Source: 2008-04/txt/msg01278.txt.bz2 >>From comp.lang.fortran: ICE on the following code module funcs implicit none ! Interface block for function program fptr will invoke ! to get the C_FUNPTR interface function get_proc(mess) bind(C,name='BlAh') use ISO_C_BINDING implicit none character(kind=C_CHAR) mess(*) type(C_FUNPTR) get_proc end function get_proc end interface end module funcs module other_fun use ISO_C_BINDING implicit none private ! Message to be returned by procedure pointed to ! by the C_FUNPTR character, allocatable, save :: my_message(:) ! Interface block for the procedure pointed to ! by the C_FUNPTR public abstract_fun abstract interface function abstract_fun(x) use ISO_C_BINDING import my_message implicit none integer(C_INT) x(:) character(size(my_message),C_CHAR) abstract_fun(size(x)) end function abstract_fun end interface contains ! Procedure to store the message and get the C_FUNPTR function gp(message) bind(C,name='BlAh') character(kind=C_CHAR) message(*) type(C_FUNPTR) gp integer(C_INT64_T) i i = 1 do while(message(i) /= C_NULL_CHAR) i = i+1 end do my_message = message(int(1,kind(i)):i-1) gp = get_funloc(make_mess,aux) end function gp ! Intermediate procedure to pass the function and get ! back the C_FUNPTR function get_funloc(x,y) procedure(abstract_fun) x type(C_FUNPTR) y external y type(C_FUNPTR) get_funloc get_funloc = y(x) end function get_funloc ! Procedure to convert the function to C_FUNPTR function aux(x) interface subroutine x() bind(C) end subroutine x end interface type(C_FUNPTR) aux aux = C_FUNLOC(x) end function aux ! Procedure pointed to by the C_FUNPTR function make_mess(x) integer(C_INT) x(:) character(size(my_message),C_CHAR) make_mess(size(x)) make_mess = transfer(my_message,make_mess(1)) end function make_mess end module other_fun program fptr use funcs use other_fun implicit none interface procedure(abstract_fun) fun end interface pointer(p,fun) type(C_FUNPTR) fp fp = get_proc('Hello, world'//achar(0)) p = transfer(fp,p) write(*,'(a)') fun([1,2,3]) end program fptr Program received signal SIGSEGV, Segmentation fault. gfc_is_compile_time_shape (as=0x0) at ../../../trunk2/gcc/fortran/array.c:2095 2095 if (as->type != AS_EXPLICIT) (gdb) bt #0 gfc_is_compile_time_shape (as=0x0) at ../../../trunk2/gcc/fortran/array.c:2095 #1 0x00000000004680ec in resolve_symbol (sym=0x101bc00) at ../../../trunk2/gcc/fortran/resolve.c:6810 #2 0x0000000000473637 in traverse_ns (st=0x101bda0, func=0x466490 ) at ../../../trunk2/gcc/fortran/symbol.c:2978 #3 0x0000000000462a40 in resolve_types (ns=0x101b4b0) at ../../../trunk2/gcc/fortran/resolve.c:9059 #4 0x000000000046646d in gfc_resolve (ns=0x0) at ../../../trunk2/gcc/fortran/resolve.c:9138 #5 0x00000000004667e9 in resolve_symbol (sym=0x1017150) at ../../../trunk2/gcc/fortran/resolve.c:8064 -- Summary: ICE on valid code Product: gcc Version: 4.4.0 Status: UNCONFIRMED Keywords: ice-on-valid-code Severity: normal Priority: P3 Component: fortran AssignedTo: unassigned at gcc dot gnu dot org ReportedBy: fxcoudert at gcc dot gnu dot org http://gcc.gnu.org/bugzilla/show_bug.cgi?id=35971