- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello all,
I've defined a new type, foo:
[cpp]type foo integer(kind=1) :: size character(len=1), dimension(:), allocatable:: token end type foo[/cpp]
I've overloaded the cat operator (//) to perform concatenation of two foo objects and now want to supply a generic interface to a repeat function foo_repeat:
[cpp]pure function foo_repeat(foo_var,n_copies) result(new_fooVar)
type(symbol), intent(in) :: foo_var
integer(kind=I_LO), intent(in) :: n_copies
type(symbol) :: new_fooVar
integer(kind=I_LO) :: kount
! Copy base_Symbol into new new_Symbol
new_fooVar = foo_Var
! Loop over new_Symbol (n_copies - 1) times concatenating new
! copies of base_Symbol each time (first copy made above)
do kount = 2,n_copies
new_fooVar = new_fooVar//foo_Var
end do
end function foo_repeat[/cpp]
I tested it and it worked fine;
[cpp]subroutine test_foo_repeat implicit none type(foo):: test_Foo, test_RepeatFoo ... test_Foo = foo(2,["1", "4"]) test_RepeatFoo = foo_repeat(test_Foo,3) ... end subroutine test_foo_repeat[/cpp]
Then I decided to define a generic interface overloading repeat:
[cpp]module foo_bar
implicit none
private
public :: foo, operator(//),..., repeat, ....
...
interface repeat
module procedure foo_repeat
end interface
...
contains
...
pure function foo_repeat...
...
end module foo_bar[/cpp]
Now when I replace foo_repeat with repeat in the test code above and compile the code I get the error #6362: The data types of the argument(s) are invalid. [REPEAT].
What's going on?
Thanks,
Rich
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I figured out what was going on here.
1. You have a bug in your code. The call to repeat passes the literal 2 as the second argument, which is default integer, but your specific procedure foo_repeat declares this argument as integer(I_LO), which is integer(2). Therefore there is no match for the generic. If you say 2_I_LO it works.
2. The reason the explicit call to foo_repeat works is that we have an extension where if you have a numeric literal as an actual argument and you are calling a non-generic procedure which declares that argument as having a different KIND, we will helpfully convert it for you. If you turn on standards checking you'll get a warning about this.
3. The compiler is giving a confusing error message because you're calling a name of an intrinsic If it wasn't an intrinsic, say, xrepeat, then you'd get a more useful message about being unable to resolve the generic. But since it is the name of a generic, you get an unhelpful message saying the arguments don't match. I will suggest to the developers that in the case of a user-overloaded intrinsic generic that the more generic (!) message be given in this circumstance.
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You've omitted so much it's hard to reconstruct what you might have done. I tried to fill in the blanks as best as I could and it compiled fine. My guess is that at the point you use REPEAT that your declaration of the generic REPEAT is not visible. Therefore you get the Fortran standard intrinsic REPEAT which takes different argument types from what you had. If you had properly extended the generic, it would work.
Here's my test version.
[cpp]module test
implicit none
! private
!public :: foo, operator(//),..., repeat, ....
!...
interface repeat
module procedure foo_repeat
end interface
type foo
integer a
integer, dimension(2) :: b
end type foo
integer, parameter :: I_LO = 4
!...
contains
pure function foo_repeat(foo_var,n_copies) result(new_fooVar)
type(foo), intent(in) :: foo_var
integer(kind=I_LO), intent(in) :: n_copies
type(foo) :: new_fooVar
integer(kind=I_LO) :: kount
! Copy base_Symbol into new new_Symbol
new_fooVar = foo_Var
! Loop over new_Symbol (n_copies - 1) times concatenating new
! copies of base_Symbol each time (first copy made above)
do kount = 2,n_copies
!new_fooVar = new_fooVar//foo_Var
end do
end function foo_repeat
end module test
subroutine test_foo_repeat
use test
implicit none
type(foo):: test_Foo, test_RepeatFoo
!...
!test_Foo = foo(2,["1", "4"])
test_RepeatFoo = foo_repeat(test_Foo,3)
!...
end subroutine test_foo_repeat[/cpp]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You've omitted so much it's hard to reconstruct what you might have done. I tried to fill in the blanks as best as I could and it compiled fine. My guess is that at the point you use REPEAT that your declaration of the generic REPEAT is not visible. Therefore you get the Fortran standard intrinsic REPEAT which takes different argument types from what you had. If you had properly extended the generic, it would work.
Here's my test version.
[cpp]module test
implicit none
! private
!public :: foo, operator(//),..., repeat, ....
!...
interface repeat
module procedure foo_repeat
end interface
type foo
integer a
integer, dimension(2) :: b
end type foo
integer, parameter :: I_LO = 4
!...
contains
pure function foo_repeat(foo_var,n_copies) result(new_fooVar)
type(foo), intent(in) :: foo_var
integer(kind=I_LO), intent(in) :: n_copies
type(foo) :: new_fooVar
integer(kind=I_LO) :: kount
! Copy base_Symbol into new new_Symbol
new_fooVar = foo_Var
! Loop over new_Symbol (n_copies - 1) times concatenating new
! copies of base_Symbol each time (first copy made above)
do kount = 2,n_copies
!new_fooVar = new_fooVar//foo_Var
end do
end function foo_repeat
end module test
subroutine test_foo_repeat
use test
implicit none
type(foo):: test_Foo, test_RepeatFoo
!...
!test_Foo = foo(2,["1", "4"])
test_RepeatFoo = foo_repeat(test_Foo,3)
!...
end subroutine test_foo_repeat[/cpp]
Hi Steve,
Thanks for the effort, I'm sorry that I wasn't clear. The problem that I'm having is that I'm trying to invoke foo_repeat via the generic interface repeat (the line in subroutine test_foo_repeat would then be:
test_RepeatFoo = repeat(test_Foo,3)
If I get make foo_repeat public and use the explicit interface, the function works. Here is the actual code, mutatis mutandis:
[cpp]!*******************************************************************************
! *
! Module: foo *
! *
! Purpose: Creates the foo object. The object captures a lexical token in the *
! form of a character array. *
! *
! Dependencies: N/A *
! *
! *
! Notes: N/A *
! *
! *
! Version: 1.0 Base implementation 07 Nov. 2008 *
! *
! References: *
! *
!*******************************************************************************
module foo_Mod
implicit none
private
public :: foo, assignment(=), len, operator(//), repeat
! Precision constants
integer, parameter:: HI=selected_real_kind(12)
integer, parameter:: LO=selected_real_kind(5)
integer, parameter:: I_HI=selected_int_kind(9)
integer, parameter:: I_LO=selected_int_kind(4)
! Define foo object
type foo
integer(kind=I_LO) :: size
character(len=1), dimension(:), allocatable :: token
end type foo
! Define assignment interface
interface assignment(=)
module procedure set_Token
module procedure get_Token
end interface
! Define operator interfaces
interface operator(//)
module procedure cat_Foo
end interface
! Define generic interface for repeat and len functions
interface repeat
module procedure foo_repeat
end interface
interface len
module procedure get_Size
end interface
! Define module procedures
contains
!***********************************************************************
!***********************************************************************
! *
! Object Manipulation *
! *
!***********************************************************************
!***********************************************************************
!***********************************************************************
! *
! Subroutine: set_Token *
! *
! Purpose: Sets the lexical token associated with foo object from an *
! input character string. *
! *
! Dependencies: len (get_Size) *
! *
! Arguments: foo_var - Foo object to which token is to be *
! assigned *
! *
! new_Token - Lexical token to be assigned *
! *
! *
! *
! Version: 1.0 Base implementation 07 Nov. 2008 *
! *
! References: *
! *
!***********************************************************************
subroutine set_Token(foo_var,new_Token)
type(foo), intent(inout) :: foo_var
character(len=*), intent(in) :: new_Token
integer(kind=I_LO) :: kount, new_Size
logical :: alloc_Flag
! Get length of new token
new_Size = len(new_Token)
! As this may be a redefinition of the symbol check allocation
! status and set alloc_Flag to true if token must be allocated
alloc_Flag = .not. allocated(foo_var%token)
! Test that any allocation is appropriate
if (.not. alloc_Flag) then
! Token has already been allocated, is it the right size
alloc_Flag = len(foo_var) /= new_Size
! If token has the wrong size, deallocate
if (alloc_Flag) then
deallocate(foo_var%token)
end if
end if
! If necessary, resize and allocate storage array
if (alloc_Flag) then
foo_var%size = new_Size
allocate(foo_var%token(new_Size))
end if
! Assign new token to foo_var object
do kount = 1,len(foo_var)
foo_var%token(kount) = new_Token(kount:kount)
end do
end subroutine set_Token
!***********************************************************************
! *
! Function: cat_Foo *
! *
! Purpose: Concatenates symbols. *
! *
! Dependencies: len (get_Size) *
! *
! Arguments: foo_var1 - Foo object to which additional foo *
! object is to be concatenated *
! *
! foo_var2 - Foo object to be concatenated to a base *
! foo object *
! *
! Returns: new_foo - New symbol formed by concatenation *
! *
! *
! Version: 1.0 Base implementation 08 Nov. 2008 *
! *
! References: *
! *
!***********************************************************************
pure function cat_Foo(foo_var1,foo_var2) result(new_foo)
type(foo), intent(in) :: foo_var1, foo_var2
type(foo) :: new_foo
integer(kind=I_LO) :: kount, new_Size
logical :: alloc_Flag
! Get length of new token
new_Size = len(foo_var1) + len(foo_var2)
! As this may be a redefinition of the foo object check
! allocation status
alloc_Flag = .not. allocated(new_foo%token)
if (.not. alloc_Flag) then
! Token has already been allocated, is it the right size?
alloc_Flag = len(new_foo) /= new_Size
! If token has the wrong size, deallocate
if (alloc_Flag) then
deallocate(new_foo%token)
end if
end if
! If necessary, resize and allocate storage array
if (alloc_Flag) then
new_foo%size = new_Size
allocate(new_foo%token(new_foo%size))
end if
! Assign new token to new symbol object
new_foo%token(:len(foo_var1)) = foo_var1%token(:)
new_foo%token(len(foo_var1)+1:) = foo_var2%token(:)
end function cat_Foo
!***********************************************************************
! *
! Function: foo_repeat *
! *
! Purpose: Concatenates symbols. *
! *
! Dependencies: len (get_Size) *
! // (cat_Foo) *
! *
! Arguments: foo_var - Foo object to which additional copies *
! are to be concatenated *
! *
! n_copies - Number of copies of foo object to be *
! concatenated *
! *
! Returns: new_foo - New foo object formed by concatenation *
! *
! Version: 1.0 Base implementation 10 Nov. 2008 *
! *
! References: *
! *
!***********************************************************************
pure function foo_repeat(foo_var,n_copies) result(new_foo)
type(foo), intent(in) :: foo_var
integer(kind=I_LO), intent(in) :: n_copies
type(foo) :: new_foo
integer(kind=I_LO) :: kount
! Copy base foo object into new new_foo
new_foo = foo_var
! Loop over new_foo (n_copies - 1) times concatenating new
! copies of base foo object each time (first copy made above)
do kount = 2,n_copies
new_foo = new_foo//foo_var
end do
end function foo_repeat
!***********************************************************************
!***********************************************************************
! *
! Object Querries *
! *
!***********************************************************************
!***********************************************************************
!***********************************************************************
! *
! Subroutine: get_Token *
! *
! Purpose: Querries a foo object for its lexical token. *
! *
! Dependencies: len (get_Size) *
! *
! Arguments: current_Token - Current token to be returned *
! *
! foo_var - Foo object which is to be querried *
! *
! *
! Version: 1.0 Base implementation 07 Nov. 2008 *
! *
! References: *
! *
!***********************************************************************
subroutine get_Token(current_Token,foo_var)
type(foo), intent(in) ::foo_var
character(len=len(foo_var)), intent(inout) :: current_Token
integer(kind=I_LO) :: kount
! Loop over elements of token and assemble the output character
! string
current_Token(1:len(foo_var)) = foo_var%token(1)
do kount = 2,foo_var%size
current_Token(1:len(foo_var)) = trim(current_Token)// &
foo_var%token(kount)
end do
end subroutine get_Token
!***********************************************************************
! *
! Function: get_Size *
! *
! Purpose: Querries a foo object for the size of its token. *
! *
! Dependencies: N/A *
! *
! Arguments: foo_var - foo object which is to be querried *
! *
! Returns: token_Size - Size of current token *
! *
! *
! Version: 1.0 Base implementation 08 Nov. 2008 *
! *
! References: *
! *
!***********************************************************************
pure function get_Size(foo_var) result(token_Size)
type(foo), intent(in) :: foo_var
integer(kind=I_LO) :: token_Size
! Extract token size
token_Size = foo_var%size
end function get_Size
! I actually have this in another module that uses foo, but it doesn't
! matter, it chokes here
subroutine testFoo(pass_Flag)
logical, intent(out) :: pass_Flag
character(len=2) :: test_String
type(foo) :: test_Foo, foo_Foo
test_String = '12'
test_Foo = test_String
! Toggle call to foo_repeat/repeat
foo_Foo = repeat(test_Foo,2)
!foo_Foo = foo_repeat(test_Foo,2)
pass_Flag = len(foo_Foo) == 2
return
end subroutine testFoo
end module foo_Mod
[/cpp]
Thanks,
Rich
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Ok, thanks. I'll investigate.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Yes, this is V11, I downloaded it this past Friday. You're describing exactly what I'm seeing though it appears to work some times (overloads of len, lle, llt, lge, lgt, and == worked fine, it seems to be just repeat here)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I figured out what was going on here.
1. You have a bug in your code. The call to repeat passes the literal 2 as the second argument, which is default integer, but your specific procedure foo_repeat declares this argument as integer(I_LO), which is integer(2). Therefore there is no match for the generic. If you say 2_I_LO it works.
2. The reason the explicit call to foo_repeat works is that we have an extension where if you have a numeric literal as an actual argument and you are calling a non-generic procedure which declares that argument as having a different KIND, we will helpfully convert it for you. If you turn on standards checking you'll get a warning about this.
3. The compiler is giving a confusing error message because you're calling a name of an intrinsic If it wasn't an intrinsic, say, xrepeat, then you'd get a more useful message about being unable to resolve the generic. But since it is the name of a generic, you get an unhelpful message saying the arguments don't match. I will suggest to the developers that in the case of a user-overloaded intrinsic generic that the more generic (!) message be given in this circumstance.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I figured out what was going on here.
1. You have a bug in your code. The call to repeat passes the literal 2 as the second argument, which is default integer, but your specific procedure foo_repeat declares this argument as integer(I_LO), which is integer(2). Therefore there is no match for the generic. If you say 2_I_LO it works.
2. The reason the explicit call to foo_repeat works is that we have an extension where if you have a numeric literal as an actual argument and you are calling a non-generic procedure which declares that argument as having a different KIND, we will helpfully convert it for you. If you turn on standards checking you'll get a warning about this.
3. The compiler is giving a confusing error message because you're calling a name of an intrinsic If it wasn't an intrinsic, say, xrepeat, then you'd get a more useful message about being unable to resolve the generic. But since it is the name of a generic, you get an unhelpful message saying the arguments don't match. I will suggest to the developers that in the case of a user-overloaded intrinsic generic that the more generic (!) message be given in this circumstance.
Duh!! Wouldn't be so bad but I just got done reworking fruit (for unit testing) to address that exact issue. Thanks Steve, you rule!
Cheers,
Rich
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page