forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

operator overloading, function overloading, intrinsic constructor

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
Anonymous
Guest





PostPosted: Wed Apr 06, 2005 11:20 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

Hi,

I'm sorry, but I have also posted this on the general forum.
I hope this is the correct place to post it.


I'm using the ft95 personal edition compiler for one month or so.
I don't have access to the compiler error reference manual ( I think this do not comes with the distribution),
so I must guess why I receive some errors at compilation.

The compiler is working fine comparing to g95 or gfortran or intel, but there is some errors I get like this one

In a module for rational arithmetic I created interfaces like


type rational
sequence
integer :: n
integer :: d
end type rational

interface min
module procedure min_Q
end interface
....

interface abs
module procedure abs_Q
end interface

....

contains
...

function abs_Q(x) result (z)
type(rational), intent(in) :: x
type(rational) :: z

z=...

end function abs_Q

The compiler returns the following error:

error 435 - Specific procedure ABS of type REAL(KIND=1) FUNCTION is too similar to ABS
of type REAL(KIND=1) FUNCTION for overload ABS in module INTEGER_ARITHMETIC_CLASS. The arguments are too similar.


I should say that, in general, overloadings of operators and standard functions are working fine (for example, min, max, ...)
In fact I have a module for integer arithmetic which is used by the rational arithmetic module and where I have made a lot of overloadings without any problem, including overloadings of min, max, abs, ...

With respect with the abs function I did noticed that there is no abs function for Integer(Cool arguments. At least I get
the following compilarion errors

for a code like this

.....
integer(Cool u,v
....

u=abs(v)
....


error 137 - Operand incompatible with opcode
fatal 123 - Invalid machine instruction generated


Therefore I overloaded abs for integer(Cool arguments with a function of my own in the integer-artithmetic_module, and this works


Finally one last error I got:

In a module for vector operations I created the type

type Vector
private
integer :: size ! vector length
real, pointer, dimension(Smile :: value ! component values
end type Vector





I have a constructor which receives an array of values and should
return a variale of my type Vector


function as_Vector (length, values) result(z)
integer, intent(in) :: length
real, target, intent(in) :: values(length)
real, pointer :: pointer_to_vaues(Smile
type (Vector) :: z
integer :: flag ! allocate flag
allocate ( pointer_to_val (length), stat = flag )
if (flag /= 0 ) stop 'allocate error'
pointer_to_values => values
z = Vector (length, pointer_to_values) ! ******
end function as_Vector


I obtain the following compilation error pointing to the line with ******

error 621 - The type constructor for TYPE(VECTOR) has not enough arguments


I fact it seems that the intrinsic constructor Vector(.,.) does not work.

I obtain the same compilation error when trying to call it from the main program.



Can any one help me on these problems?

Thank you in advance.
Carlos


cmmenez


cmmenez
Back to top
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Fri Apr 08, 2005 1:54 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

Cool The first problem you mention (error 435) may well be due to a bug in the compiler.
The second (error 137) is certainly a bug.
The third (error 621) again looks like a potential bug.

You have supplied sufficient information for me the check how FTN95 responds to passing a pointer in a constructor (error 621). For the other two I need two very short programs that illustrate each problem. If you can post these I will investigate them as soon as possible. Cool
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Fri Apr 08, 2005 2:21 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

I can now confirm that error 621 represents a bug in FTN95.
There is also an inconsistency in your code.

You should have either

allocate(pointer_to_values(length))
pointer_to_values = values

if you want to copy the values or just

pointer_to_values => values

without ALLOCATE, if you want to point to the original values.

Back to top
View user's profile Send private message AIM Address
Anonymous
Guest





PostPosted: Fri Apr 08, 2005 8:48 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

Here is some code where the other two errors occurs. Sorry if this is not sufficientrly short.
I have not modified substantially the code, but this is only a small fraction of the whole code.
For me Integer(JKIND) and integer(LKIND) is just, as you can see,
integer(SELECTED_INT_KIND(1Cool)

The errorrs (for the ABS overloading) occurs with this code.

The error for the inexistence of ABS function for integer(JKIND)
occurs with this code if you "UNINTERFACE" function longinteger_abs_J



Thank you for your support.
Carlos


module standard_numbers
implicit none
integer, parameter :: IKIND=KIND(1)
integer, parameter :: JKIND=SELECTED_INT_KIND(1Cool
integer, parameter :: LKIND=SELECTED_INT_KIND(1Cool
integer, parameter :: DKIND=KIND(1.d0)
integer, parameter :: RKIND=KIND(1.e0)

logical, parameter :: TRUE=.TRUE.
logical, parameter :: FALSE=.FALSE.

end module standard_numbers



module Integer_Arithmetic_Class

!---------------------------------------------------------------------------------------------------
use standard_numbers
implicit none

!-----------------------------------------------------------------------------------------------------
type longinteger
sequence
! integer(IKIND),public :: nmax !maximum words allocated
integer(IKIND),public :: n !number of words used
integer(IKIND),public :: sign ! sign
integer(IKIND),public :: digit(0:40) !number of words
end type longinteger



interface abs
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module procedure longinteger_abs_J
!!!! UNINTERFACE THIS TO GET ERROR 137
end interface

interface gcd
module procedure integer_gcd_JJ
end interface

contains
function longinteger_abs_J(x) result(z)
integer(JKIND),intent(in) :: x
integer(JKIND) :: z
z=x
if (z < 0) z= -z
end function longinteger_abs_J


function integer_gcd_JJ(x,y) result(d)
integer(JKIND) x,y,d
integer(JKIND) u,v,t
u=abs(x)
v=abs(y)
if(u>v) then
t=u
u=v
v=t
end if
if (v == 0)then
v=1
else
while (u>0) do
t=u
u=mod(v,t)
v=t
end do
end if
d=v
end function integer_gcd_JJ


end module Integer_Arithmetic_Class

module Rational_Arithmetic_Class
use Integer_Arithmetic_Class
implicit none

!---------------------------------------------------------------------------

!---------------------------------------------------------------------------
! Define a derived type called rational that contains two integer(LKIND)
! components, n and d.
! n is the numerator and d is the denominator

type rational
sequence
integer(LKIND) :: n
integer(LKIND) :: d
end type rational



interface abs
module procedure rational_abs_Q
end interface



interface min
module procedure rational_min_QQ
end interface


contains








function rational_abs_Q (x) result (z)
type(rational),intent(in) :: x
type(rational) ::z
z%n=abs(x%n)
z%d=abs(x%d)
end function rational_abs_Q


function rational_min_QQ(x,y) result (z)
type(rational),intent(in) :: x
type(rational),intent(in) :: y
type(rational) :: z
if(x%n * y%d - x%d*y%n < 0) then
z=x
else
z=y
end if
end function rational_min_QQ

end module Rational_Arithmetic_Class










Cmmenez
Back to top
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Apr 11, 2005 5:25 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

There is only limited support for 64 bit integers in FTN95.
If you can manage with SELECTED_INT_KIND(9) then two of your problems will be solved.

As a work-around for the constructor bug you could use simple assignments such as:

v%size = 4
v%value => array
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Apr 11, 2005 9:38 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

This bug has now been fixed.
The current release is FTN95 version 4.80.
The fix will be available in the next release or service pack after 4.80.
Back to top
View user's profile Send private message AIM Address
Anonymous
Guest





PostPosted: Mon Apr 11, 2005 11:56 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

Thank you.
I suppose I can download the new version of ftn95.

As for the problem with the abs overloading, I will try to use only integer(4) variables instead of integer(Cool,
to see if the overloading of abs for rational numbers (pairs of integer variables) will work.
May be tomorow.

Carlos.


cmmenez
Back to top
Anonymous
Guest





PostPosted: Tue Apr 12, 2005 1:33 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote


If the answer to the following question is YES, may be you don't want
to read what follows it. Otherwise please read what I have found.

IS IT A RULE (FROM THE FORTRAN 95 STANDARDS OR OF FTN95 DESIGN)
THAT AN INTRINSIC FUNCTION LIKE "ABS" CANNOT BE OVERLOADED IN TWO DIFFERENT MODULES?


!
! The following code do not produce any compilation error, although
! the integer variables n and d that define the type rational in module Rational_Arithmetic_Class
! are of selected_int_kind(1Cool.
!
! However if you move the functions longinteger_abs_J or longinteger_sign_J or exp1 (which for now
! are in the module Rational_Arithmetic_Class ) to the
! module Integer_Arithmetic_Class, uncomment the interface code in this last module, and
! comment the interface to those routines in the Rational_Arithmetic_Class module
! you obtain the error I have reported before:
!
!
!error 435 - Specific procedure SIGN of type REAL(KIND=1) FUNCTION is too similar to SIGN of type REAL(KIND=1) FUNCTION for overload SIGN in module INTEGER_ARITHMETIC_CLASS. The arguments are too similar.
!error 435 - Specific procedure ABS of type REAL(KIND=1) FUNCTION is too similar to ABS of type REAL(KIND=1) FUNCTION for overload ABS in module INTEGER_ARITHMETIC_CLASS. The arguments are too similar.
!error 1044 - This generic call to ABS is ambiguous as both of the specifics ABS and LONGINTEGER_ABS_J could match the arguments as supplied
!error 1044 - This generic call to ABS is ambiguous as both of the specifics ABS and LONGINTEGER_ABS_J could match the arguments as supplied
!
! Please notice that there are two overloads of ABS (resp. SIGN, and EXP)
! One for longinteger_abs_J, and another for rational_abs_Q (resp. ....).
! The second overload must be in the module RATIONAL_ARITHMETIC_CLASS, and the proper place for the first
! overload is in the module INTEGER_ARITHMETIC_CLASS.
! The code as I present makes the two overloadings in the module
! RATIONAL_ARITHMETIC_CLASS and do not produce a compilation error.
! However if you make the changes I referred to above (one overload in each module).
! the error occurs.
!
! So I believe that the error 425 I'm being reporting is not caused by the integer(selected_int_kind(1Cool),
! because with the above modifications the same error occurs
! --- if you change the fields n and d
! in the definition of type(rational) to integers of selected_int_kind(9),
! --- or if you modify longinteger_abs_J to have an argument and result
! of some other type you have created,
! for instance my
! type longinteger
! which is defined in module INTEGER_ARITHMETIC_CLASS
!
! In fact I believe that the problem is related to some names clash for ABS and SIGN and EXP,...
! when these functions are overloaded in different modules (perhaps only in the case where one uses
! one module within another and overloads on both modules the function ABS or SIGN or EXP,
! which is my case).
!
! In order to test if my conjecture is correct I created two new types, type T1 in module
! INTEGER_ARITHMETIC_CLASS and type T2 in module RATIONAL_ARITHMETIC_CLASS and decided to
! overload intrinsic function EXP with functions EXP1 with argument and result of type T1
! function EXP2 with argument and result of type T2 with some "nonsensical" code.
! When both functions overload EXP in the module RATIONAL_ARITHMETIC_CLASS (as is the present code)
! there is no compilation error. If I overload EXP with EXP1 in the INTEGER_ARITHMETIC_CLASS module
! and EXP with EXP2 in the RATIONAL_ARITHETIC_CLASS module the following error occurs
!
! error 435 - Specific procedure EXP of type REAL(KIND=1) FUNCTION is too similar to EXP of type REAL(KIND=1) FUNCTION for overload EXP in module INTEGER_ARITHMETIC_CLASS. The arguments are too similar.
!
! Therefore it seems that most intrinsic functions cannot be overloaded in two different modules.
!
! However notice that I have overloaded MIN and MAX (may be with
Back to top
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Tue Apr 12, 2005 2:42 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

I don't know of any constraint in the Standard that restricts the various overloads to one module.
It should work. However, it is probably simpler and tidier to put them all in the same module.
Back to top
View user's profile Send private message AIM Address
Anonymous
Guest





PostPosted: Wed Apr 13, 2005 5:13 am    Post subject: operator overloading, function overloading, intrinsic constr Reply with quote

I disagree with you. Sometimes it can be simpler and tidier. Most of times it is not, and forbids the construction of
"sub" modules for stand alone usage. For instance if module B uses module A, and the overloads are declared only on module B
one cannot use only module A with its own overloads unless one recodify them in module A. So one
must have two versions of module A. One for stand alone usage and one to be used by module B.
I think this is not good practice and it is error and version-problem prone.


Thank you for your attention.
Carlos

cmmenez
Back to top
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group