Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
New Contributor II
16 Views

Easier way to declare an allocatable string please

I keep thinking how verbose the new allocatable character string is when I am having to type it out two fingered as is my poor typing:

character(:), allocatable :: aString

If anybody on the standards commitee (Steve) reads this then why was it specified like this and how about something much simpler:

string aString

 

0 Kudos
2 Replies
Highlighted
Black Belt Retired Employee
16 Views

What do you propose? Deferred-length character is a natural extension of existing syntax and features. Coming up with entirely new syntax would not get much support. 

0 Kudos
Highlighted
Valued Contributor II
16 Views

As Steve said, the current syntax fits in well with the rest of the language. If you want more verbose, there is always

program P
   implicit none
   type(character(LEN=:,KIND=KIND('A'))) aString
   allocatable aString
   aString = 'Hello, world'
   write(*,'(*(g0))') aString,len(aString)
end program P

The most serious syntactic problem arises when you want to point a deferred-length character pointer at a char * pointer you got from a C procedure. There is no direct syntax for that so you have to use a BLOCK construct:

module GFWIN
   use ISO_C_BINDING
   implicit none
   private
   integer, parameter, public :: &
      HANDLE = C_INTPTR_T, &
      DWORD = C_LONG

   integer(DWORD), parameter, public :: &
      FORMAT_MESSAGE_FROM_SYSTEM = int(Z'00001000',DWORD), &
      FORMAT_MESSAGE_ALLOCATE_BUFFER = int(z'00000100',DWORD)

   public LoadLibrary
   interface
      function LoadLibrary(lpFileName) bind(C,name='LoadLibraryA')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: LoadLibrary
!GCC$ ATTRIBUTES STDCALL :: LoadLibrary
         integer(HANDLE) LoadLibrary
         character(KIND=C_CHAR) lpFileName(*)
      end function LoadLibrary
   end interface

   public GetLastError
   interface
      function GetLastError() bind(C,name='GetLastError')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetLastError
!GCC$ ATTRIBUTES STDCALL :: GetLastError
         integer(DWORD) GetLastError
      end function GetLastError
   end interface

   public FormatMessage
   interface
      function FormatMessage(dwFlags,lpSource,dwMessageId,dwLanguageId, &
         lpBuffer,nSize,Arguments) bind(C,name='FormatMessageA')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: FormatMessage
!GCC$ ATTRIBUTES STDCALL :: FormatMessage
         integer(DWORD) FormatMessage
         integer(DWORD), value :: dwFlags
         integer(HANDLE), value :: lpSource
         integer(DWORD), value :: dwMessageId
         integer(DWORD), value :: dwLanguageId
         character(KIND=C_CHAR) lpBuffer(*)
         integer(DWORD), value :: nSize
         type(C_PTR), value :: Arguments
      end function FormatMessage
   end interface

   public LocalFree
   interface
      function LocalFree(hMem) bind(C,name='LocalFree')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: LocalFree
!GCC$ ATTRIBUTES STDCALL :: LocalFree
         integer(HANDLE) LocalFree
         integer(HANDLE), value :: hMem
      end function LocalFree
   end interface
end module GFWIN

program P
   use GFWIN
   use ISO_C_BINDING
   implicit none
   integer(HANDLE) :: H
   integer(DWORD) E
   character(len=SIZEOF(0_HANDLE),kind=C_CHAR) lpBuffer
   type(C_PTR) C
   character(len=:,kind=C_CHAR), pointer :: M
   integer(DWORD) L
   integer(HANDLE) I
   H = LoadLibrary("I don't exist"//achar(0))
   if(H == 0) then
      E = GetLastError()
      L = FormatMessage( &
         IOR(FORMAT_MESSAGE_FROM_SYSTEM,FORMAT_MESSAGE_ALLOCATE_BUFFER), &
         0_HANDLE,E,0,lpBuffer,8_DWORD,C_NULL_PTR)
      C = transfer(lpBuffer,C)
      BLOCK
         character(len=L,kind=C_CHAR), pointer :: Q
         call C_F_POINTER(C,Q)
         M => Q
      END BLOCK
      write(*,'(*(g0))') M(1:L-1)
      I = LocalFree(transfer(C,0_HANDLE))
   end if
end program P

 

0 Kudos