Im trying to use interfaces to call different subroutines with different types, however, it doesnt seem to work when i use the pointer attribute. for example, take this sample code
MODULE ptr_types
TYPE, abstract :: parent
INTEGER :: q
END TYPE
TYPE, extends(parent) :: child
INTEGER :: m
END TYPE
INTERFACE ptr_interface
MODULE PROCEDURE do_something
END INTERFACE
CONTAINS
SUBROUTINE do_something(atype)
CLASS(parent), POINTER :: atype
! code determines that this allocation is correct from input
ALLOCATE(child::atype)
WRITE (*,*) atype%q
END SUBROUTINE
END MODULE
PROGRAM testpass
USE ptr_types
CLASS(child), POINTER :: ctype
CALL ptr_interface(ctype)
END PROGRAM
This gives error
Error: There is no specific subroutine for the generic 'ptr_interface' at (1)
however if i remove the pointer attribute in the subroutine it compiles fine. Now, normally this wouldnt be a problem, but for my use case i need to be able to treat that argument as a pointer, mainly so i can allocate it if necessary.
Any suggestions? Mind you I'm new to fortran so I may have missed something
edit: forgot to put the allocation in the parents subroutine, the initial input is unallocated
EDIT 2
this is my second attempt, with caller side casting
MODULE ptr_types
TYPE, abstract :: parent
INTEGER :: q
END TYPE
TYPE, extends(parent) :: child
INTEGER :: m
END TYPE
TYPE, extends(parent) :: second
INTEGER :: meow
END TYPE
CONTAINS
SUBROUTINE do_something(this, type_num)
CLASS(parent), POINTER :: this
INTEGER type_num
IF (type_num == 0) THEN
ALLOCATE (child::this)
ELSE IF (type_num == 1) THEN
ALLOCATE (second::this)
ENDIF
END SUBROUTINE
END MODULE
PROGRAM testpass
USE ptr_types
CLASS(child), POINTER :: ctype
SELECT TYPE(ctype)
CLASS is (parent)
CALL do_something(ctype, 0)
END SELECT
WRITE (*,*) ctype%q
END PROGRAM
however this still fails. in the select statement it complains that parent must extend child. Im sure this is due to restrictions when dealing with the pointer attribute, for type safety, however, im looking for a way to convert a pointer into its parent type for generic allocation. Rather than have to write separate allocation functions for every type and hope they dont collide in an interface or something.
hopefully this example will illustrate a little more clearly what im trying to achieve, if you know a better way let me know
As indicated by High Performance Mark, you have a mismatch in the declared type of the actual and dummy arguments for the call to ptr_interface. This isn't permitted if the dummy argument has the pointer or allocatable attribute - see 12.5.2.5p2 of F2008.
There's a simple rationale for this restriction (which is discussed in Note 12.27 in the F2008 standard) - without it it would be possible for the subroutine to allocate the dummy argument to be of a type that is incompatible with the actual argument. For example - imagine if there was another extension of Parent in the program somewhere - a sibling of Child in the type heirarchy. If your do_something procedure allocate its dummy argument to that sibling type, then back in the the calling scope you have something declared as type Child that is actually some other incompatible (not an extension of Child) type.
If the do_something procedure cannot allocate the thing to anything other than type Child, then make its dummy argument of type Child. If it can allocate it to some other type that is an extension of Parent, then you need to make the declared type of the actual argument type Parent as well. You can use the SELECT TYPE construct to then downcast to an object of Child type in the calling scope.
Subsequent to your edits, my suggestion was for your main program to look something like:
PROGRAM testpass
USE ptr_types
IMPLICIT NONE ! <--
CLASS(Parent), POINTER :: ctype
!***
! ctype here is a pointer with undefined association status,
! (so no concept of dynamic type) and declared type Parent.
CALL do_something(ctype, 0)
! Assuming successful ALLOCATE(Child :: xxx) in the procedure,
! ctype here is an associated pointer with dynamic type Child.
SELECT TYPE(ctype)
CLASS is (Child)
! Declared type of ctype in here is Child. Dynamic type
! in this specific case is also Child, but this block would
! also be executed if the dynamic type was a further extension
! of Child, because a CLASS IS guard was used. (A TYPE IS
! guard requires an exact match of dynamic type.)
!
! If the allocate in do_something allocated the dummy argument
! to be of type second or nullified the argument, then this
! block of code would not be executed. If do_something left
! the association status of the pointer undefined, then
! your program is non-conforming, and anything could happen.
WRITE (*,*) ctype%m
! Continue to work with ctype as a thing with declared type
! Child inside this block of the select type construct.
END SELECT
! ctype back to having a declared type of Parent.
WRITE (*,*) ctype%q
! Don't forget deallocation!
END PROGRAM
If I change your line
CLASS(child), POINTER :: ctype
to
CLASS(parent), POINTER :: ctype
then your program compiles and executes. I'm quite new to all this object-oriented Fortran myself so I struggle to point to the clause in the standard which states the rules for rank-type-kind matching in this case and clarifies your mistake. Your mistake may simply be to use a compiler which doesn't implement the latest features of the language. On the other hand, perhaps my compiler (Intel Fortran 13.1) implements the latest features as incorrectly as yours does.
(On past form a guy named IanH here on SO will pass by later and clarify.)
One thing I have learned though, is that if your compiler is Fortran 2003 compliant (enough) then making variables ALLOCATABLE rather than POINTER makes a number of operations easier and passes the responsibility for freeing unwanted memory to the compiler. You don't need pointers for dynamic memory management in Fortran any more.
I think that your problem comes from the POINTER attribute of the argument in the subroutine do_something. Delete it and all should work.
Related
Say you have a declared type dat1 which has a default numbers of members. Depending on run time, this dat1 may or may not be extended with other types. This is easy as you can use the extends feature. However, if you have an array of dat1 and some elements of that array may or may not want to inherit another type - how is this done most reasonably.
I have the following example:
type dat1
real :: x(3)
type(dat2), allocatable :: rnd
type(dat1), pointer :: next => dat1
end dat1
Now I used a linked list to do this. My question is basically if it is the correct way to declare the second type rnd as an allocatable, and then just allocate it whenever a node requests it.
The other option is to declare it as a pointer i.e. type(dat2), allocatable :: rnd, now is there any significant differences, despite the common Fortran differences with pointers vs alloctables like explicit/implicit deallocation, contiguous memory etc.
Note that no matter what, each dat1 node will always have either 0 or 1 rnd type attached to it.
I was considering during runtime that I would check if rnd was allocated or for pointer it would be associated.
Components of a derived type have the same concerns as general pointer/allocatable variables.
However, there are additional aspects of interest regarding components:
automatic deallocation: on deallocating a derived type object any allocated allocatable components are deallocated; pointer components are not automatically deallocated or disassociated.
type references: both pointer and allocatable components may be of the type being defined (here dat1) or defined at a later point, but for allocatable components this is a feature not available before Fortran 2008 and is not massively supported by compilers.
One difference not mentioned in the linked question's answer is relevant to this question. Here you say:
I was considering during runtime that I would check if rnd was allocated or for pointer it would be associated
It is always allowed to ask ALLOCATED(x%rnd) (allocatable), but it is not always allowed to ask ASSOCIATED(x%rnd) (pointer). A pointer component may be of undefined association status whereas an allocatable component will always have defined allocation status.1
You may therefore want to set an initial association status of the pointer component.
1The case of undefined allocation status (of Fortran 90) and allocatable components have never co-existed in the standard.
Generally speaking, Ada will raise a Constraint_Error if you attempt to dereference a null pointer (access type). However, this behavior is disabled if, for example, you have pragma Suppress (all_checks) in use.
Given this scenario, how would one go about checking to see if the access type points to 0x0 (null)?
Consider the following:
type My_Access_Type is access all My_Type'Class;
procedure myProcedure ( myAccess : in My_Access_Type ) is
begin
-- need to have check in here
end
if myAccess = null then
...
end if;
Although it won't necessarily point to 0x0. Access types are not pointers, and may be implemented in a different way than plain addresses.
Another option, that can help you, is to declare the pointer as "not null".
type My_Access is not null access My_Type;
this prevents the declaration of not initialized My_Access types.
X : My_Access; -- compile error
This solution as some disadvantages (see https://en.wikibooks.org/wiki/Ada_Programming/Types/access#Null_exclusions) and its correct usage depends on your needs.
Let's consider a complex structure in fortran
TYPE ComplexStrType
! Static as well as dynamic memory defined here.
END TYPE ComplexStrType
Defined a physical space (allocated on the stack memory I think) to use two variables of ComplexStrType:
TYPE(ComplexStrType) :: SomeComplexStr
TYPE(ComplexStrType) :: AnotherComplexStr
TYPE(ComplexStrType),POINTER :: PointerComplexStr
Then, I use SomeComplexStr to define a few stuff in the stack and to allocate a big space in the dynamic memory.
Now, suppose I want to point AnotherComplexStr to SomeComplexStr and forget space I have defined in the stack memory to AnotherComplexStr. To do that I use a simple but useful trick which converts some variable in a Target:
FUNCTION TargComplexStr(x)
IMPLICIT NONE
TYPE(ComplexStrType),INTENT(IN),TARGET :: x
TYPE(ComplexStrType),POINTER :: TargComplexStr
TargComplexStr => x
END FUNCTION TargComplexStr
And then I point PointerComplexStr to SomeComplexStr:
PointerComplexStr => TargComplexStr(SomeComplexStr)
Finally, I do AnotherComplexStr equal to PointerComplexStr:
AnotherComplexStr = PointerComplexStr
After that, it's supposed SomeComplexStr as well AnotherComplexStr are pointing to the same static and dynamic memory.
The thing is:
How can I free the space used by AnotherComplexStr used when I defined it at the beggining?
How do you recomend me nullify the pointers?
Is that practice safe, or do I have to expect some strange memory leaks on the execution?
If it's possible, how can I point the "pointed variable" to its original form? (Just in case I have to use it again as normal variable)
NOTE: It's useful because at the execution we can be decided if we want to use AnotherComplexStr as what it is, a complex and allocated structure, or we can switch it to be treated as a pointer and points it to another thing which already has the information we need. If there is another and easy way to do that, please tell me.
The "trick" that you are using in TargComplexStr does not work the way you think - that function offers nothing useful over simple pointer assignment.
You can associate a non-TARGET actual argument with a TARGET dummy argument, as you are doing, but when the procedure with the TARGET dummy argument completes, any pointers that were associated with the dummy argument become undefined (F2008 12.5.2.4 p11).
(Pointers can only be associated with targets, therefore something that isn't a target cannot have a pointer associated with it.)
This means that the result of the function is a pointer with undefined association status. It is not permitted to return a pointer with undefined association status from a function (F2008 12.6.2.2 p4).
The pointer assignment statement would then make PointerComplexStr become an undefined pointer. PointerComplexStr is then referenced in the assignment to AnotherComplexStr. It is not permitted to reference a pointer with undefined association status (F2008 16.5.2.8 p1).
Intrinsic assignment creates a copy of a value. This is the case even if the object on the right is a pointer - a copy of the value of the target of that pointer is created. Intrinsic assignment does not, at the level of the top data object being assigned[1], make one variable reference the storage of another. As far as I can tell, the intent of your entire example code could be replaced by:
AnotherComplexStr = ComplexStr
If you are trying to do something different to that, then you need to explain what it is that you are trying to do.
[1]: If the type of an object being assigned is a derived type that has a pointer components, then the definition of the value of the object includes the pointer association status of the pointer component, but not the value of the target of the component itself (F2008 4.5.8).
I am using pointers to pass some arrays to a subroutine and then allocate that array inside that subroutine and send it back to the first subroutine. In one module I have something like this:
module call_test
subroutine bla
use test
double precision, dimension(:), pointer :: xyz
!
interface boink
subroutine boink(a)
implicit none
double precision, dimension(:), pointer :: a
end subroutine boink
end interface boink
!
call boink(xyz)
deallocate(xyz)
end subroutine bla
end module call_test
and in another module I have:
module test
contains
subroutine boink(a)
implicit none
double precision, dimension(:), pointer:: a
allocate(a(10))
end subroutine boink
end module test
It works fine, but the problem is by doing this process each time, i.e. calling the subroutine bla many times, I am allocating some memory that won't be deallocated which causes me memory issues. Is there any way to deallocate the array "a" in the second module after using it in the first module?
It will only be a problem if you allocate the same pointer multiple times without deallocation. You can change the allocation part to first detect if the pointer has already been allocated:
if(associated(a))deallocate(a)
allocate(a(10))
Of course, if you point a to some other variable b that cannot be deallocated, this would cause some serious problems.
If all you need a for is a resizable array, it will probably better to make it allocatable instead of pointer. That way you will never have memory leaks.
"bla" calls "boink"` whichs allocates a pointer array. Then "bla1" deallocates it. There is no memory leak. It doesn't matter that the two procedures use different names for the same pointer array.
Why do you have an interface for "boink" in module "call_test" when that module uses module "test", which contains "boink"? The use will make the interface of "boink" known in module "call_test".
the code
program asd
real,pointer :: a,b,c
allocate(a)
a=2.0
b=>a
c=>a
deallocate(b) !
print *, associated(c,target=a) ! T
end program
return T with intel compiler. I conclude that "b" is not a full alias of "a", since I can not deallocate "a" taking "b".
So my question is: if I construct a pointer with
function ptr
real,pointer :: var,ptr
allocate(var)
ptr=>var
end function
It is possible to deallocate var after to call this function?
Thank a lot-
The standard says (section 6.3.3.2):
... Deallocating a pointer target causes the pointer association status of
any other pointer that is associated with the target or a portion of the target to become undefined.
Further on, in section 16.4.2.1, it says:
A pointer may have a pointer association status of associated, disassociated, or undefined.
and in note 16.3 it points out that:
A pointer from a module program unit may be accessible in a subprogram via use association.
Such pointers have a lifetime that is greater than targets that are declared in the subprogram,
unless such targets are saved. Therefore, if such a pointer is associated with a local target, there is
the possibility that when a procedure defined by the subprogram completes execution, the target
will cease to exist, leaving the pointer “dangling”. This standard considers such pointers to have
an undefined association status. They are neither associated nor disassociated. They shall not be
used again in the program until their status has been reestablished. There is no requirement on a
processor to be able to detect when a pointer target ceases to exist.
All of that is to say that the result of .TRUE. from Intel you are getting is compiler-specific because c has an undefined association status, which compilers can report any way they want. If you tried to access a through c, you would get a memory error (or even if it works, it is undefined and not a guarantee).
Likewise, your example function is just as dangerous because there is no guarantee that var will exist when the function returns, meaning the ptr function result is again undefined. So again, if you tried to access var through the result of ptr, you would again get a memory error.
If you want your function to work, it would need to look like:
function ptr
real, pointer, save :: var
real,pointer :: ptr
allocate(var)
ptr=>var
end function
Of course, this begs the ultimate question -- why ALLOCATE pointers? It's much safer to use ALLOCATABLE for the target and give it the TARGET attribute.