Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
Announcements
Welcome to the Intel Community. If you get an answer you like, please mark it as an Accepted Solution to help others. Thank you!
26748 Discussions

Easier way to declare an allocatable string please

Andrew_Smith
New Contributor III
82 Views

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
Steve_Lionel
Black Belt Retired Employee
82 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. 

JVanB
Valued Contributor II
82 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

 

Reply