论坛 › Fortran语法讨论 › fortran字符串指针的问题

roxillius 发表于 2016-6-27 19:41:00

fortran字符串指针的问题

这是chapman书里指针一章的一道作业，大致就是用链表来做插入排序。我实现了一个link list type，这个type 的定义如下
type :: char_node
   character(len=:), pointer :: value
   type(char_node), pointer :: next_value
end type char_node
然后重载了几个计算符（> < ==）
主程序插入排序的代码如下，
program insertion
use link_list
implicit none
type(char_node), pointer :: head, tail, ptr, ptr1, ptr2
integer :: istat
integer :: nvals = 0
character(len=128) :: temp
character(len=20) :: filename
nullify(head,tail,ptr,ptr1,ptr2)
write (*,*) 'Enter the file name of data to be sorted: '
read (*,'(a20)') filename
open (unit=9,file=filename, status = 'old', action = 'read', &
       iostat=istat)
fileopen: if (istat == 0) then
   input: do
      read (9, *, iostat=istat) temp
      if (istat /= 0) exit input
      nvals = nvals + 1
      allocate(ptr, stat=istat)
      nullify(ptr%value)
      allocate(character(len_trim(adjustl(temp))) :: ptr%value, stat=istat)
      ptr%value = trim(adjustl(temp))
      new : if (.not. associated(head)) then
         head => ptr
         tail => head
         nullify (ptr%next_value)
      else
         front : if(ptr < head) then
            ptr%next_value => head
            head => ptr
         else if (ptr > tail .or. ptr == tail) then
            tail%next_value => ptr
            tail => ptr
            nullify(tail%next_value)
         else
            ! find place to add the value
            ptr1 => head
            ptr2 => ptr1%next_value
            search: do
               if ((ptr>ptr1 .or. ptr==ptr1) .and. (ptr<ptr2)) then
                  ! insert the value here
                  ptr%next_value => ptr2
                  ptr1%next_value => ptr
                  exit search
               end if
               ptr1 => ptr2
               ptr2 => ptr2%next_value
            end do search
         end if front
      end if new
   end do input
   ptr => head
   output : do
      if (.not. associated(ptr)) exit
      write (*,'(1x,a,i3)') ptr%value, len(ptr%value)
      ptr => ptr%next_value
   end do output
else fileopen
   write (*,'(1x,a,i6)') 'File open failed -- status =', istat
end if fileopen
end program insertion
程序能够正常排序，但是每个链表里字符串指针的长度都是128 与 temp字符串相符。为什么我用allocate动态空间的字符串长度还是128？
谢谢大家。

roxillius 发表于 2016-6-27 22:14:42

我补充一下链表module的源代码module link_list
private
public :: char_node, operator(>), operator(<), operator(==)
type :: char_node
   character(len=:), pointer :: value
   type(char_node), pointer :: next_value
end type char_node

interface operator (<)
   module procedure less_than
end interface operator (<)

interface operator (>)
   module procedure greater_than
end interface operator (>)

interface operator (==)
   module procedure equal_to
end interface operator (==)
contains
logical function less_than(op1,op2)
    type(char_node), intent(in) :: op1, op2
    character (len=len(op1%value)) :: temp1
    character (len=len(op2%value)) :: temp2
    call toupper(op1%value,temp1)
    call toupper(op2%value,temp2)
    if (llt(temp1, temp2)) then
       less_than = .true.
    else
       less_than = .false.
    end if
end function less_than

logical function greater_than(op1,op2)
    type(char_node), intent(in) :: op1, op2
    character (len=len(op1%value)) :: temp1
    character (len=len(op2%value)) :: temp2
    call toupper(op1%value,temp1)
    call toupper(op2%value,temp2)
    if (lgt(temp1, temp2)) then
       greater_than = .true.
    else
       greater_than = .false.
    end if
end function greater_than

logical function equal_to(op1,op2)
    implicit none
    type(char_node), intent(in) :: op1, op2
    character (len=len(op1%value)) :: temp1
    character (len=len(op2%value)) :: temp2
    call toupper(op1%value,temp1)
    call toupper(op2%value,temp2)
    if (lge(temp1, temp2) .and. lle(temp1,temp2) ) then
       equal_to = .true.
    else
       equal_to = .false.
    end if
end function equal_to

subroutine toupper(input,output)
    implicit none
    character(len=*),intent(in) :: input
    character(len=*),intent(out) :: output
    integer :: i, istat
    integer :: length
    length = len(input)
    output = input
    do i = 1, length
       if (lge(output(i:i),'a') .and. lle(output(i:i),'z')) then
          output(i:i) = achar (iachar(output(i:i))-32)
       end if
    end do
end subroutine toupper
end module link_list

li913 发表于 2016-6-28 18:36:34

本帖最后由 li913 于 2016-6-28 18:45 编辑

我这里没问题。vs2010+ivf2016

vvt 发表于 2016-6-28 20:46:52

我想这应该是编译器的 bug，我这里测试也是有问题
我尝试把
allocate(character(len_trim(adjustl(temp))) :: ptr%value, stat=istat)
改为
allocate(character(len_trim(temp)) :: ptr%value, stat=istat)
或
k = len_trim(adjustl(temp))
allocate(character(k) :: ptr%value, stat=istat)
都是正常的。

roxillius 发表于 2016-6-29 16:02:05

感谢！
看来确实是编译器的问题。
另外我用的编译器是gFortran 5.3.0 (homebrew 5.3.3)。

pasuka 发表于 2016-6-30 09:51:41

本帖最后由 pasuka 于 2016-6-30 09:55 编辑

那本书上的代码有点顾影自怜，因为写书的时候尚没有一家编译器实现所有F03标准
学习链表、字符串处理，推荐下面的开源项目，虽然也是好久没更新了
http://flibs.sourceforge.net/

查看完整版本: fortran字符串指针的问题