Derived type definition locations

Dear all,

possibly silly and pedantic question incoming.
Where in a piece of code can I define a derived type? Can they be freely mixed with variable declarations as long as the order is OK (i.e. defined before used)? A quick test and some logic suggests they are just like variables in this sense, but I prefer to be sure per standard.

Heather

Hi @hratcliffe,

generally it’s a good practice to define derived types in the specification section of a module. You can also define a type in a program or a procedure, and it can be used within the body and internal procedures.

You can even create “hidden” derived types, which to my understanding, can only be used in the context of an associate statement:

module bar
implicit none
public :: foo
contains
function foo() result(f)
   type :: foo_type
      integer :: first
      real(kind(1.0d0)) :: second
      real, allocatable :: third
   end type
   type(foo_type) :: f
   f = foo_type(42, 5.0d0)
end function
end module

program main
use bar
implicit none

associate(f => foo())
   print *, f%first
   print *, f%second
   print *, allocated(f%third)
end associate

end program

Within this particular language carve-out, you can also use-before-define, e.g.

program picalc
implicit none
integer, parameter :: dp = kind(1.0d0)
integer :: i, n
real(dp) :: pi
n = 10000
associate(points => [(random_point(),i=1,n)])
   pi = count(points%x**2 + points%y**2 < 1,dim=1) * 4.0_dp/n
end associate
print '("pi = ", G0)', pi
contains
type(point) function random_point() result(p)
   type :: point
      real(kind(1.0d0)) :: x, y
   end type
   call random_number(p%x)
   call random_number(p%y)
end function
end program

I haven’t yet made my mind if this “hidden type” syntax is useful/beneficial. If a type is supposed to remain hidden it can always be defined in a module and given the private attribute.

And it’s OK to mix them in the specification section? Like

INTEGER :: foo
TYPE bar
  ...
END TYPE
TYPE(bar) :: charlie

Yes, these are all R508 specification-construct (in particular, type-declaration-stmt, derived-type-def and type-declaration-stmt again).

1 Like

It looks very weird to me, to be able to reference derived type components in a segment which does not have that type declared. IMHO, it should not be allowed.

NB. gfortran (v. 13.2, 14.2) gives ICE on third print line:

   23 |    print *, allocated(f%third)
      |                              1
internal compiler error: in fold_convert_loc, at fold-const.cc:2757

I submitted a bug a couple weeks ago: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=117077

ifort, ifx, flang(-new), and nagfor all accept the example:

> nagfor hidden_type.f90 
NAG Fortran Compiler Release 7.2(Shin-Urayasu) Build 7203
[NAG Fortran Compiler normal termination]
> ./a.out
pi = 3.156400000000000

The interpretation document J3/24-007 (section 7.3.2.2, paragraph 2) has this cryptic paragraph about the case when a type is declared within a function:

A derived-type-spec, enum-type-spec, or enumeration-type-spec in a TYPE type specifier in a type declaration statement shall specify a previously defined type. If the data entity is a function result, the type may be specified in the FUNCTION statement provided the type is defined within the body of the function or is accessible there by use or host association. If the type is specified in the FUNCTION statement and is defined within the body of the function, it is as if the function result were declared with that type immediately following the definition of the specified type.

Actually, I have a similar question about the usage like f => foo(), which appeared in several other threads but I still cannot understand what is happening under the hood. For example, does this sentence

associate(f => foo())

mean that the symbol f is associated with the result variable of foo() with a “const” like attribute? In that case, is the result variable not limited to the above sentence but kept alive for the entire associate block? Or, does the Standard say nothing about such implementation-related things but just imply that (for example) “f behaves like foo() in the associate block”? (Then, it seems to imply that we are doing something equivalent to foo() % first etc, which is not supported in the current Fortran (as far as I experienced…)

Another related question is what happens when the result variable is a pointer. I.e., does the symbol => work as pointer assignment, value assignment, or possibly neither of them? (e.g., like macro substitution of foo()) I learned Fortran mainly from books, but my understanding about these points is still very vague… (So, at the moment I avoid using associate for expressions (except for very simple ones), in fear of different compilers behaving differently…)

A full explanation of how the construct works is given in J3/24-007, section 11.1.3. Here are just a few excerpts.

From 11.1.3.1, paragraph 1:

The ASSOCIATE construct associates named entities with expressions or variables during the execution of its block. These named construct entities (19.4) are associating entities (19.5.1.6). The names are associate names.

From 11.1.3.2, paragraph 1:

Execution of an ASSOCIATE construct causes evaluation of every expression within every selector that is a variable designator and evaluation of every other selector, followed by execution of its block. During execution of that block each associate name identifies an entity which is associated (19.5.1.6) with the corresponding selector. The associating entity assumes the declared type and type parameters of the selector. If and only if the selector is polymorphic, the associating entity is polymorphic.

From 11.1.3.4, paragraph 5:

The associating entity itself is a variable, but if the selector is not a definable variable, the associating entity is not definable and shall not be defined or become undefined. If a selector is not permitted to appear in a variable definition context (19.6.7), neither the associate name nor any subobject thereof shall appear in a variable definition context or pointer association context (19.6.8).

1 Like

To me, that cryptic paragraph seems to only allow something like:

type(foo_type) function foo() result(f)
   type :: foo_type
      integer :: first
      real(kind(1.0d0)) :: second
      real, allocatable :: third
   end type

Still, I cannot see (although I am no expert on the Standard, so I would gladly hear I am wrong) how such a type could be propagated outside that function. In the main program that you gave in the example, one cannot declare type(foo_type) :: var and yet, one can use the type’s internal structure in the associate construct.

Sorry for quoting only the part about the type definition. The answer how it can be propagated outside is specified in the ASSOCIATE semantics (see my previous post). Note that the function result type (i.e. the type of the evaluated selector) is public, so the associating entity has a known type:

          associating entity
          v
associate(f => foo())
               ^
               selector

I was surprised to discover this obscure corner of the language myself. Some related threads where I was exploring ASSOCIATE include:

I think there’s also circumstances where a second definition is considered the same type as long as the content is the same. So in weird enough codes that might still be useful?

Two data entities have the same type if they are declared with reference to the same derived-type definition. Data
7 entities also have the same type if they are declared with reference to different derived-type definitions that specify
8 the same type name, all have the SEQUENCE attribute or all have the BIND attribute, have no components
9 with PRIVATE accessibility, and have components that agree in order, name, and attributes.

1 Like

Well, I accept that it works. Still, it seems inconsistent to me, that in

type (foo_type) :: var_foo   ! error
associate (f => foo())
 print *, f%first            ! ok
 ! [...]
end associate

the var_foo declaration is invalid while f in the associate block is legally recognized as type (foo_type)

Edit: I think what you deem inconsistent, isn’t allowed because of

C795 (R754) type-name shall be the name of an accessible derived type.

The name of the type declared within a function isn’t accessible in the context where the function is called. Accessibility implies that you either import the derived type from a module, or that it be available from the scope or via host association.

If you want to have a public type to create variables, you don’t need to nest it in the function body; you can just put it in the specification section of the parent scope (i.e. program, procedure, module.)

program picalc
implicit none
integer, parameter :: dp = kind(1.0d0)
type :: point
   real(dp) :: x, y
end type

type(point) :: p ! okay here
! ...
contains
   type(point) function random_point() result(p) ! and also here
      ! ...
   end function
end program

@hratcliffe’s comment brings some extra light. It makes sense for creating external procedures callable from C without having to use modules:

! external (i.e. non-module) procedure
type(rgb_t) function color() bind(c)
   type, bind(c) :: rgb_t
       integer(c_int) :: r, g, b
   end type
   ! ...
end function

You could stick the type definitions in an include file to remove repetition and guarantee consistency.

Same goes for sequence types. I’ve only encountered one in practice. I imagine it is useful for loading/storing fixed-size objects from/to memory, say a bitmap file header, where it’s desirable the order of the structure is preserved exactly. I imagine another usage could be for a core dump or the register file of a (virtual) machine.


I do wonder with F2023 introducing the TYPEOF declaration-type-spec, if this is allowed:

associate (f => foo())
   block
      typeof(f) :: g ! is this allowed?
 ! ...
   end block
end associate

I’m not really sure what to say from the constraints in J3/24-007, section 7.3.2.1.

P.S. J3/24-007: It’s not just a standard, it’s a mission—bringing Fortran into the future with a license to compute. :wink:

Oh crumbs, is that a full equivalent of decltype in C++ ? That has some interesting potential.

I think I can see a circular dependency situation where modules A and B would depend on each other unless both defined certain types independently. It would be a sign of pretty terrible design I guess, but I could see it happening during a refactor and I guess BIND(C) to ensure the layout would be a temporary workaround.

At first I thought because of

C710 The data-ref in a TYPEOF or CLASSOF specifier shall have its type and type parameters previously declared or established by the implicit typing rules.

It would not be valid, but

The associating entity assumes the declared type and type parameters of the selector.

suggests it is.

Seems like a very non-deliberate consequence. I thought this language quirk was interesting because you could suppress assignment to f, but know with typeof(...) I’m not sure that holds anymore, because I could write:

 associate (f => foo())
   block
      typeof(f) :: g
      g = f           ! intrinsic assignment
! ...
   end block
end associate

I still don’t see how this could be useful. Maybe in some out-of-ordinary generic/template situation.

What is the value added by the new classof and typeof constructs? is that something along the lines of C++ auto (although not exactly), with goal being that type specifiers do not need to be repeated several times? I understand that types must be known at compile time anyway so it does not provide any generic programming capabilities, it only is an enhancement for lazy programmer :slight_smile:

I think it is closer to decltype than auto. See section 2.3 on page 5:

That reminds me of the quote,

“Much of my work has come from being lazy,” Backus once said, with characteristic modesty. “I didn’t like writing programs, so I started work on a system to make them easier to write.”

Overuse of auto is pretty lazy, but wasn’t it partly introduced on account of some iterator(iirc) types whose type could not be written out?

Like @ivanpribec says, I think it’s more like decltype anyway, and that has niche but powerful uses in generic programming.

7 posts were split to a new topic: New generic procedures feature