Initializing global/module variable object

This is related to object initialization, not value types.

Lets say I have an class defined as:

module A
  private
  type AA
  end type AA
  interface AA
    module procedure AA_constructor
  end interface AA
contains
  function AA_constructor() result(this)
    type(AA) :: this
    print *, "Constructing AA"
  end function AA_constructor
end module A

And there I want to add a static object:

module A
...
  type(AA) :: a_obj = AA()
...
contains
...
end module

This does not work unfortunately because only intrinsic functions are accepted.

Is there any way around this? I want to have these variables be instantiated by the library, not by the executable. Nevermind the static intialization fiasco, these can be avoided with proper singleton implementations.

The equivalent C++ code that achieves this is

#include <iostream>

namespace A{
  class A{
  public:
    A() {
      std::cout << "Constructing AA" << std::endl;
    }
  };
  A a_obj = A();
}
2 Likes

The application that I have in mind is for plugin system, so the init_module has to be called by an external module without hard-coding each module that has been implemented. This unfortunately does not satisfy that condition.

A C++ example implementation is like this:

// interface.h
#pragma once
#include <list>
class interface{
  static list<interface*> all_interfaces {};
  interface(){
    all_interaces.push_bach(this);
  }
  virtual void init() = 0;
};

(I am deliberately ignoring the static initialization fiasco here (all_interfaces should be initialized before being called in the constructor) to make the example more readable)
Then a simple implementation is:

// implementationA.cpp
#include "interface.h"
class implA: interface{
  void init() override{
    ...
  }
};
// The important part is the static initialization
implA InstanceA{};

with an example usage as

#include "interface.h"
int main(){
  for (auto intf : interface::all_interfaces)
    intf->init();
  return 0;
}

The important aspects is that, this call is only called in implementationA.cpp, and nothing upstream needs to know about the existence of implA class. I don’t see any fotranic way of implementing this.

@lecris,

In a general case, the answer will be, unfortunately, no. Fortran is “funny that way”!!

A lot of the semantics in the language are half-baked due to various issues in the language standard development process.

Consider the following:

module m
   type :: t1
      integer :: n(1) = [ 42 ] !<-- component initialization
   end type
   type :: t2
      integer, allocatable :: n(:)
   end type
   type(t1) :: foo !<-- Ok, foo%n defined as [ 42 ]
   type(t2) :: bar = t2( [ 42 ] ) !<-- Not Ok; NO structure constructor can define bar%n as
                                  !            anything other than NULL() in a variable definition in a declaration statement
end module

So, if you are authoring a “class” (basically a derived type in Fortran), with your “class” members (type components in Fortran parlance) that are nonallocatable (and nonpointer), the language semantics with component initialization does a lot for you e.g., with type t1 above.

But for “class” members which are ALLOCATABLE (and POINTER), watch out for various idiosyncrasies. There are these so-called constraints in the standard involving constant expressions that prevent definition of the object in conjunction with the declaration statement. The definition then has be a so-called executable statement and everything that entails comes along with it.

Here’s a non-standard :warning: hack :warning: to achieve initialization using global constructors that I found out about on OSDev.org,

// foo.c
#include <stdio.h>

 // Global variables
int x = 42;
struct { float a[5]; } s;

__attribute__ ((constructor)) void foo(void)
{
    printf("foo is called first!\n");
    
    // Fill array
    for (int i = 0; i < 5; i++) s.a[i] = i;
}

__attribute__ ((destructor)) void bar(void)
{
    puts("Au revoir.");
}
! main.f90
module foo
use, intrinsic :: iso_c_binding
implicit none
private
public :: x, s
integer(c_int), bind(c,name="x") :: x
type, bind(c) :: something
   real(c_float) :: a(5)
end type
type(something), bind(c,name="s") :: s
end module

program main
use foo, only: x, s
print *, "x = ", x
print *, "s.a[:] = ", s%a
end program
~/fortran/constructor$ gcc-13 -c foo.c 
~/fortran/constructor$ gfortran-13 -o main main.f90 foo.o
~/fortran/constructor$ ./main
foo is called first!
 x =           42
 s.a[:] =    0.00000000       1.00000000       2.00000000       3.00000000       4.00000000

To understand why and how this works read the section 18.20.5 on How Initialization Functions Are Handled in the GCC internals manual. The meaning of the constructor/destructor attributes can be found here.

Bear in mind, this is just a “side-effect” of the GCC Fortran implementation sitting on top of the C Runtime Initialization system (also known as crt0.o). This is also why you have two “main” symbols in the symbol table:

$ echo "end" > program.f90
$ gfortran program.f90 
$ nm a.out 
0000000100003ed9 t _MAIN__
0000000100008010 d __dyld_private
                 U __gfortran_set_args
                 U __gfortran_set_options
0000000100000000 T __mh_execute_header
0000000100003ee0 T _main
0000000100003f50 s _options.0.0
                 U dyld_stub_binder

There is a Fortran _MAIN__ which is called from the C _main. I suppose it’s more of an OS or platform thing, than related to the compiler. Intel Fortran on Mac also does things this way:

$ ifort -o main main.f90 foo.o
$ nm main | grep -i "main"
0000000100003f50 T _MAIN__
0000000100003f00 T _main

On a different operating system, there might be no such hook. On Windows for example with MSVC it’s already a bit more complex.

To make this more “plugin”-friendly, we could borrow a technique I saw used for extending Eigen’s MatrixBase class:

// user_plugins.c
#include "user_plugin_config.h"

#ifdef USER_PLUGIN
#include USER_PLUGIN

__attribute__ ((constructor)) void user_plugin_init(void) {
   register_plugin();
}
#endif
// user_plugin_config.h

/* users may modify this file */

#define USER_PLUGIN "MyPlugin.h"
// MyPlugin.h

// Put global data here
// ...

void register_plugin(void) {
  // Initialization goes here
  // ...
}

Now that I think about it, R’s system for registering native routines (C and Fortran) is a similar type of thing.

1 Like

Perhaps you will consider to address more complex cases that may not be interoperable with a C companion processor, such as with ALLOCATABLE components?

Because for the case you describe, a standard-conforming approach already exists for MODULE entities that are variables:

module foo
   use, intrinsic :: iso_c_binding, only : c_int, c_float
   integer(c_int), bind(C, name="x"), save :: x = 42
   type, bind(C) :: something
      real(c_float) :: a(5)
   end type
   type(something), bind(C, name="s"), save :: s = something( a=[( real(i,kind(s%a)), integer :: i = 0, size(s%a)-1 )] )
end module
program main
   use foo, only: x, s
   print *, "x = ", x
   print *, "s.a[:] = ", s%a
end program
C:\temp>ifort /free /standard-semantics p.f
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.10.0 Build 20230609_000000
Copyright (C) 1985-2023 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 14.36.32537.0
Copyright (C) Microsoft Corporation.  All rights reserved.

-out:p.exe
-subsystem:console
p.obj

C:\temp>p.exe
 x =  42
 s.a[:] =  0.000000 1.000000 2.000000 3.000000
 4.000000
// foo.c
void init_b(void);

static __attribute__ ((constructor)) void foo(void)
{
    puts("foo is called first!");
    init_b();
}
! main.f90
module foo
implicit none
private
real, allocatable, public :: b(:)
contains
  ! Do your complex initialization in a Fortran function
  subroutine init_b() bind(c)
    b = [1,2,3]
  end subroutine
end module

! -> Hidden foo routine called here <-
program main
use foo, only:  b
print *, allocated(b), b
end program
$ gcc-13 -c foo.c 
$ gfortran-13 -o main main.f90 foo.o
$ ./main
foo is called first!
 T   1.00000000       2.00000000       3.00000000    
3 Likes

Interesting hack Ivan. Would putting the C function call in a C++ class constructor make this really compiler-independent? One could have an instance of the “initializer” class globally declared somewhere I guess.

I can’t really answer your question. At the end of the day this is just an implementation quirk. I mean there is nothing that mandates a C++ namespace or static class be initialized before the Fortran main program starts. But in practice, because the Fortran compilers we use sit on top of platforms predominantly implemented in C/C++, it happens to work this way.

With C++ you don’t even need a global “initializer” class, but you can just use an immediately-invoked function expression (IIFE), hidden in an anonymous namespace:

// foo.cpp

namespace foo_impl__ {

    // Anonymous namespace
    namespace {

        extern "C" void init_b(void);

        bool foo_initialized = [](){
            init_b();
            return true;
        }(); // IIFE (Immediately-invoked function expression)

    }

    int is_foo_initialized() { return foo_initialized ? 1 : 0; }
}

extern "C"
int is_foo_initialized() { 
    return foo_impl__::is_foo_initialized(); 
}

This way the init_b routine is hidden from the Fortran module user and the C++ user. Since there is no public header, no C user should be able to call it either (unless he inspects the object files to know it’s there).

Addendum: I’m also not aware of what the standard says (if anything) about a private module procedure with bind(c). In principle this procedure could be eliminated from the object output if it’s not used, but in practice they appear to be part of the object output. You could bypass any potential module-related limitation by having the Fortran initialization function as an external routine,

! foo_init_b.f90
subroutine init_b() bind(c)
use foo, only: b
b = [1.,2.,3.]
end subroutine

but now you can only modify public module variables.

Second addendum: I added code to query the initizalization status (1 - success, 0 - failed).

2 Likes

I’m trying to declare a version_t object from GitHub - minhqdao/version-f: Semantic Versioning 2.0 in Fortran as a compile-time parameter (which seems reasonable for a program version that should not change during the program execution).

If I understand correctly the above discussion, this is not possible :

module test
  use version_f
  implicit none

  type(version_t), parameter :: version = version_t(0, 1, 2)

end module

This indeed fails with message Function 'version_t' in initialization expression at (1) must be an intrinsic function using gfortran.

Same error with parameter removed.

I’m quite surprise that the language forbids this very basic thing, that’s why I’m asking again…

I believe your example as written is actually valid (and would also be with the parameter attribute), because it doesn’t define the allocatable components. @sblionel laid out the rules pretty well in a previous thread

The version_t is an alias for the create procedure, and not the structure constructor. Hence it cannot be used to initialize a variable with the parameter attribute.

But if you use the structure-constructor, it works:

module test
  implicit none
  type :: string_t
    character(:), allocatable :: str
  end type
  type :: version_t
    integer :: major, minor, patch
    type(string_t), allocatable :: prerelease(:)
    type(string_t), allocatable :: build(:)
  end type
end module

program abc
use test
type(version_t), parameter :: v = version_t(0, 1, 2)
print *, v%major, v%minor
end program

Oh, do you think it’s a gfortran bug, then?

It’s not a bug. It’s because of how the library is written. Using version_t doesn’t invoke the structure-constructor, but an impure procedure called create (version-f/src/version_f.f90 at aeb3c899a4ec1783131d61dc0de1cf2669cd25e0 · minhqdao/version-f · GitHub).

1 Like

You’re right, in version_f.f90, if I change the interface name in:

  interface version_t
    module procedure create, parse
  end interface

It works.

I’d recommend consulting the author of the version-f package, if version_t is to be used in a parameter context. If not, it forces package authors to provide a module initialization function (in the form of a free function that needs to be called somewhere), which doesn’t sound very practical to me.

Personally, I find the idea of bringing in a package dependency to define a version string – over-complicated. I imagine the use of the semantic-f package was primarily for writing tools doing dependency management. Hence, the version_t variables are dynamic and initialized at runtime.

Oops, didn’t scroll down far enough in the source code. The default structure constructor is shadowed by this, so you can’t use it, and thus can’t initialize the variable (as @ivanpribec pointed out). Sorry for the confusion.