Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
New Contributor II
3 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
3 Views

What do you propose? Deferred

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. 

Steve (aka "Doctor Fortran") - https://stevelionel.com/drfortran
0 Kudos
Highlighted
Valued Contributor II
3 Views

As Steve said, the current

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