- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page