- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am seeing some very odd behavior when compiling on different machines. The following code compiles and runs as expected on 32 bit Ubuntu (with ifort 11.1.046 non-commercial) but on x86_64 RHEL running the full on commercial version of ifort 11.1.046 throwing the -g flag causes compilation to hang. Also unless you call the sllist procedures by their module procedure name, rather than their type bound name, without the -g the code will compile but you will get segfaults on the 64 bit machine. If you call all functions by their module procedure name (from within the modhashtbl.f90 module) the code runs correctly on both machines, but still hangs on 64 bit RHEL when compiled with -g.
In general I have found the type bound procedures and many other OOP Fortran 2003 features essentially a waste of time due to unpredictable behavior. I wouldrecommendmore testing before declaring features as "implemented."
Here is the module:
[fortran]! Copyright (c) Izaak Beekman 2010 ! This program is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License as published by ! the Free Software Foundation, either version 3 of the License, or ! (at your option) any later version. ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Lesser General Public License for more details. ! You should have received a copy of the GNU Lesser General Public License ! along with this program. If not, see <>>. MODULE hashtbl IMPLICIT NONE ! Use strong typing INTEGER, PARAMETER :: tbl_size = 50 TYPE sllist TYPE(sllist), POINTER :: child => NULL() CHARACTER(len=:), ALLOCATABLE :: key, val CONTAINS PROCEDURE :: put => put_sll PROCEDURE :: get => get_sll PROCEDURE :: free => free_sll END TYPE sllist TYPE hash_tbl_sll TYPE(sllist), DIMENSION(:), ALLOCATABLE :: vec INTEGER :: vec_len = 0 LOGICAL :: is_init = .FALSE. CONTAINS PROCEDURE :: init => init_hash_tbl_sll PROCEDURE :: put => put_hash_tbl_sll PROCEDURE :: get => get_hash_tbl_sll PROCEDURE :: free => free_hash_tbl_sll END TYPE hash_tbl_sll PUBLIC :: hash_tbl_sll CONTAINS RECURSIVE SUBROUTINE put_sll(list,key,val) CLASS(sllist), INTENT(inout) :: list CHARACTER(len=*), INTENT(in) :: key, val INTEGER :: keylen, vallen keylen = LEN(key) vallen = LEN(val) IF (ALLOCATED(list%key)) THEN IF (list%key /= key) THEN IF ( .NOT. ASSOCIATED(list%child) ) ALLOCATE(list%child) CALL put_sll(list%child,key,val) END IF ELSE IF (.NOT. ALLOCATED(list%key)) & ALLOCATE(CHARACTER(len=keylen) :: list%key) list%key = key IF (ALLOCATED(list%val)) DEALLOCATE(list%val) ALLOCATE(CHARACTER(len=vallen) :: list%val) list%val = val END IF END SUBROUTINE put_sll RECURSIVE SUBROUTINE get_sll(list,key,val) CLASS(sllist), INTENT(in) :: list CHARACTER(len=*), INTENT(in) :: key CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: val INTEGER :: vallen vallen = 0 IF (ALLOCATED(list%key) .AND. (list%key == key)) THEN vallen = LEN(list%val) IF (ALLOCATED(val)) DEALLOCATE(val) ALLOCATE(CHARACTER(len=vallen) :: val) val = list%val ELSE IF(ASSOCIATED(list%child)) THEN ! keep going CALL get_sll(list%child,key,val) ELSE ! At the end of the list, no key found IF (ALLOCATED(val)) DEALLOCATE(val) ! Exit indication RETURN END IF END SUBROUTINE get_sll RECURSIVE SUBROUTINE free_sll(list) CLASS(sllist), INTENT(inout) :: list IF (ASSOCIATED(list%child)) THEN CALL free_sll(list%child) DEALLOCATE(list%child) END IF list%child => NULL() IF (ALLOCATED(list%key)) DEALLOCATE(list%key) IF (ALLOCATED(list%val)) DEALLOCATE(list%val) END SUBROUTINE free_sll SUBROUTINE init_hash_tbl_sll(tbl,tbl_len) CLASS(hash_tbl_sll), INTENT(inout) :: tbl INTEGER, OPTIONAL, INTENT(in) :: tbl_len IF (ALLOCATED(tbl%vec)) DEALLOCATE(tbl%vec) IF (PRESENT(tbl_len)) THEN ALLOCATE(tbl%vec(0:tbl_len-1)) tbl%vec_len = tbl_len ELSE ALLOCATE(tbl%vec(0:tbl_size-1)) tbl%vec_len = tbl_size END IF tbl%is_init = .TRUE. END SUBROUTINE init_hash_tbl_sll ! The first part of the hashing procedure using the string ! collating sequence ELEMENTAL FUNCTION sum_string(str) RESULT(sig) CHARACTER(len=*), INTENT(in) :: str INTEGER :: sig CHARACTER, DIMENSION(LEN(str)) :: tmp INTEGER :: i FORALL (i=1:LEN(str)) tmp(i) = str(i:i) END FORALL sig = SUM(ICHAR(tmp)) END FUNCTION sum_string SUBROUTINE put_hash_tbl_sll(tbl,key,val) CLASS(hash_tbl_sll), INTENT(inout) :: tbl CHARACTER(len=*), INTENT(in) :: key, val INTEGER :: hash hash = MOD(sum_string(key),tbl%vec_len) CALL tbl%vec(hash)%put(key=key,val=val) ! Call via module procedure name to run error free ! on x86_64 RHEL 5 END SUBROUTINE put_hash_tbl_sll SUBROUTINE get_hash_tbl_sll(tbl,key,val) CLASS(hash_tbl_sll), INTENT(in) :: tbl CHARACTER(len=*), INTENT(in) :: key CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: val INTEGER :: hash hash = MOD(sum_string(key),tbl%vec_len) CALL tbl%vec(hash)%get(key=key,val=val) ! Call via module procedure name to run error free ! on x86_64 RHEL 5 END SUBROUTINE get_hash_tbl_sll SUBROUTINE free_hash_tbl_sll(tbl) CLASS(hash_tbl_sll), INTENT(inout) :: tbl INTEGER :: i, low, high low = LBOUND(tbl%vec,dim=1) high = UBOUND(tbl%vec,dim=1) IF (ALLOCATED(tbl%vec)) THEN DO i=low,high CALL tbl%vec(i)%free() ! Call via module procedure name to run error free ! on x86_64 RHEL 5 END DO DEALLOCATE(tbl%vec) END IF tbl%is_init = .FALSE. END SUBROUTINE free_hash_tbl_sll END MODULE hashtbl [/fortran]
Here is the test program:
[fortran]! Copyright (c) Izaak Beekman 2010 ! This program is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License as published by ! the Free Software Foundation, either version 3 of the License, or ! (at your option) any later version. ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Lesser General Public License for more details. ! You should have received a copy of the GNU Lesser General Public License ! along with this program. If not, see <>>. PROGRAM test_hashtbl USE hashtbl IMPLICIT NONE TYPE(hash_tbl_sll) :: table CHARACTER(len=:), ALLOCATABLE :: out INTEGER, parameter :: tbl_length = 100 INTEGER :: sum, i, rand_int1, rand_int2 ! 4 byte integer, hopefully REAL :: rand CHARACTER(len=4) :: rand_str1, rand_str2 ! each char should be 1 byte PRINT*, ' ' PRINT*, 'This program is free software: you can redistribute it and/or & &modify it under the terms of the GNU Lesser General Public License& & as published by the Free Software Foundation, either version 3 of& & the License, or (at your option) any later version.' PRINT*, ' ' PRINT*, 'This program is distributed in the hope that it will be useful,& & but WITHOUT ANY WARRANTY; without even the implied warranty of& & MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the & &GNU Lesser General Public License for more details.' PRINT*, ' ' PRINT*, 'You should have received a copy of the GNU Lesser General Public & &License along with this program. If not, see & &<>>.' PRINT*, ' ' CALL table%init(tbl_length) CALL table%put(key='first_name', val='John') PRINT*, 'Hash: ', MOD(sum_string('first_name'),tbl_length) CALL table%put(key='last_name', val='Smith') PRINT*, 'Hash: ', MOD(sum_string('last_name'),tbl_length) CALL table%put(key='birthday', val='July 30, 1964') PRINT*, 'Hash: ', MOD(sum_string('birthday'),tbl_length) CALL table%put(key='hair_color', val='brown') PRINT*, 'Hash: ', MOD(sum_string('hair_color'),tbl_length) CALL table%put(key='eye_color', val='brown') PRINT*, 'Hash: ', MOD(sum_string('eye_color'),tbl_length) CALL table%put(key='weight', val='213 lbs') PRINT*, 'Hash: ', MOD(sum_string('weight'),tbl_length) CALL table%put(key='height', val='6''3"') PRINT*, 'Hash: ', MOD(sum_string('height'),tbl_length) PRINT*, ' ' CALL table%get(key='first_name',val=out) PRINT*, out CALL table%get('last_name',out) PRINT*, out CALL table%get('birthday',out) PRINT*, out CALL table%get('hair_color',out) PRINT*, out CALL table%get('eye_color',out) PRINT*, out CALL table%get('weight',out) PRINT*, out CALL table%get('height',out) PRINT*, out ! INCLUDE 'stress_test.f90' PRINT*, ' ' sum = 0 PRINT*, 'Indices of the hash table with content:' DO i = LBOUND(table%vec,dim=1), UBOUND(table%vec,dim=1) IF (ALLOCATED(table%vec(i)%key)) THEN PRINT*, i sum = sum + 1 END IF END DO PRINT*, 'Total used elements:', sum CALL table%free PRINT*, ' ' STOP 0 END PROGRAM test_hashtbl [/fortran]
Link Copied
4 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
This was marked private, but no one replied, so I am making it visible to all, in hopes that someone will reply.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you for the convenient reproducer. Our apologies for the lack of an earlier reply; the private designation was not an issue. I will investigate the described issues and update this post as I learn more.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Using version 11.1.072 on x86_64 Suse-11.1, I did not encounter the problems described.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
As mecej4 indicated, version 11.1.072 (11.1 Update 6) does not exhibit the problems described. I did not experience the compilation hang with g but rather an internal compiler error with that when compiling modhashtble.f90. With some help I also verified the program runs correctly when calling the type bound names.
Thank you mecej4.

Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page