How to create an "undefined" state of logical variables?

Hello,

For real variables, I often set the initial values to NaN (explicitly or by compiler options) so that the code gives clearly wrong results when I forget to assign an appropriate values, e.g., from input files. For integer variables, I can also set some artificial values to represent an “undefined” state, e.g., setting -99999 (or using huge() etc). Here, I am wondering if there is a way to achieve the same goal for logical variable also, somehow…? (e.g., by using transfer() and setting some dummy value to them…?)

2 Likes

As discussed elsewhere, internal representation of logical values is not defined by standard and, indeed, different in different implementations.

The only way to achieve “undefined” status is, AFAIU, declare variable as allocatable and then check whether it has been allocated.

2 Likes

Hi, I don’t know if you could indeed rely on something different from a .true./.false. on your logical variables given that regardless of how you initialize it, being defined as logical they will be reinterpreted as just .true./.false… I think it would be better if you rely on the logical being either one its values at initialization.

The transfer function will just return a logical, the bytes of your integer will not be fully copied. So it will not help in what you are trying to achieve. Also, transfer will behave differently depending on the compiler you use (with gfortran anything but 0 will return .true., with intel, you might get .true. or .false. depending on the last byte of the integer, unless you use -standard-semantics)

This might be of help to understand the issue Why no logical ==? - #57 by urbanjost

This might be a better option indeed.

1 Like

For the most part, Fortran compiler writers (and many users) are afraid of runtime checks. Typically compilers have a single bit pattern for .true., anything else is .false… So no uninitialized value pattern that might cause an abend. I believe Siverfrost is the only exception since long departed Watfor. It has an option for runtime checking for the use of an uninitialized variable. You can reliably test for uninitialized values for any compiler with valgrind:

gfortran -g test.for
valgrind ./a.out

will show the line number (but not the variable name) for the undefined assignment.

The fear of runtime checks is usually not justified. An optimizing compiler will move most checks outside of inner loops, so the overhead is often small. Valgrind is slow because it can’t do that.

2 Likes

But then I don’t think you’d be able to use it in a namelist, not until allocated, which defies the purpose.

1 Like

I don’t see any reference to namelist in OP, so I do not quite understand your remark. @septc mentioned a value that either gives clear error when used “undefined” or at least has a “special” values, easy to check/notice. I guess trying to use unallocated logical variable will give an error, won’t it?

1 Like

@septc great question. I wonder if there is a way to somehow do this in a compiler to instrument the code to give a runtime error if an uninitialized value is used (for all types).

1 Like

I think your description is correct. If I interpret the standard correctly, this is always required to work correctly, meaning that the integer j ends up with the value of the integer i. The thing that is ambiguous about transfer() is what exactly is in b. And in another thread, there is a discussion about possible alignment issues, where the addresses of b might be inconsistent with those of i. Also, the combined operation j=transfer(transfer(i,b),i) should always result in the same values for i and j. Here there is an intermediate of type b, but it cannot be accessed separately within fortran, one would need to look at the machine instructions to see where the intermediate was placed and examine it that way.

1 Like

A logical variable is always in an undefined state after it is declared as far as the language is concerned (apart from data statements and initialization). What you are asking is whether that undefined state can be detected by the programmer. I think the answer is no. The workaround for this is to define a separate shadow variable that maintains the state information. This might be a logical or an integer, for example, depending on how many defined and undefined states are allowed. The language does not help with this, it is up to the programmer to keep the shadow variable up to date with the actual variable.

One post suggests making it allocatable, and then using the allocation status as a two-state flag. That requires the programmer to allocate and deallocate the variable as its definition status changes throughout the program, and it also, of course, requires that the allocatable attribute always be associated with that variable. That is, all dummy arguments associated with that variable would need to be allocatable and code inserted where necessary to keep its status up to date. There is also this pesky feature of fortran that allocatable variables (of any type) cannot be initialized, and that might further limit the usefulness of this approach.

1 Like

In a general context, not specific to this question.

Consider using integers as substitutes for logical if a true/false initialization ain’t good enough.

That is, if you like to program like so where you rely on a conpiler-specific option like snan for reals, etc. to help with catching misses in object definition.

Because compilers are only likely to give you a choice of either true or false as default e.g., -finit-logical=<true|false> in gfortran

1 Like

Assuming the compiler does not allow treating logicals as integers (but a lot do) and that “.true.” and “.false.” always generate the same bit pattern, it seemed that some compiler might have a compiler option that if a logical had any other value that it would throw an error but I could not find one that did. So you could initialize logical values with transfer to something like the bit pattern for the integer huge(0) and then (assuming you only use logicals following the Fortran standard) test the logical value for not being either the value “.true.” or “.false.”. The standard does not say those two are always the same two values but in practice I do not know of an exception to that. It would require all your logical values to be tested before use yourself. If you wrote all your logical expressions to use a function that tested it would be possible, as in
“if(green)” becoming “if(test(green))” where GREEN is type logical, and TEST() would check if the value was one of the two “valid” bit patterns; and you could initialize all your logicals with TRANSFER statements to some value other than the reserved two. If you use a preprocessor you could define a macro that becomes just the expression for production but calls the TEST() function for debugging.

So in practice there is a way I think; but it would be an excessive amount of work unless done by the compiler; and if the compiler were going to do it some option so all variables are structures with an “initialized” component as considered above might be feasible but I think the overhead would be horrible. So it seems “possible” but not so sure about “practical”, although I did not actually try that scheme. Just a “thought experiment”.

1 Like

The NAG compiler has the option -C=undefined, which causes the compiler to track the definition status of all variables and report usage of undefined data. It has the caveat that it does not work with code compiled without that option, does not work with bind(C), and does not work with code compiled with -coarray (so no parallel features).

3 Likes

Intel Fortran has a run-time option -check:uninit that can throw an exception when an undefined object is referenced:

   logical :: l
   print *, l
end
C:\temp>ifort /free /check:uninit p.f
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.8.0 Build 20221119_000000
Copyright (C) 1985-2022 Intel Corporation.  All rights reserved.

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

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

C:\temp>p.exe
forrtl: severe (194): Run-Time Check Failure. The variable \'_UNNAMED_MAIN$$$L\' is being used in \'C:\temp\p.f(2,4)\' without being defined
Image              PC                Routine            Line        Source
p.exe              00007FF733935A99  Unknown               Unknown  Unknown
p.exe              00007FF73393104C  Unknown               Unknown  Unknown
p.exe              00007FF733981E4E  Unknown               Unknown  Unknown
p.exe              00007FF7339821D0  Unknown               Unknown  Unknown
KERNEL32.DLL       00007FF997737614  Unknown               Unknown  Unknown
ntdll.dll          00007FF997C026A1  Unknown               Unknown  Unknown

It appears however OP seeks to initialize objects to arbitrary defaults and use some home-brew program logic to work with them as opposed to run-time exceptions and compile-time warnings (there will likely be too many with OP’s approach). OP can better make do with integers in that case as opposed to the logical type.

2 Likes

The Silverfrost compiler (available for Windows only) puts Z’80’ into every byte of a variable to help with detecting attempted usage of uninitialized variables, including logical variables. A 4-byte default logical variable is initialized to Z’80808080’ if the /undef or /checkmate options are used.

Years ago, I came across a situation in which this pattern was used in the Fortran source of a library program to test for initialization of integer variables, but the FTN95 runtime caused the program to abort when the test was attempted. Unlike the situation for real/double numbers, there is no bit pattern that does not correspond to a valid value for integer, character (Z’00’ is a character, too) or logical type variables.

1 Like

I’m very sorry for late reply (it was a hard time for me the last month…) and I really appreciate a lot of inputs!!

Initially, I imagined that there might be some well-known (?) “hack” for using a logical variable for values other than true/false, but it seems it is simply invalid or non-portable, so best to be avoided (even if it may work for some environment).

Among the possible workarounds suggested above, I feel using an integer variable may be the simplest and also easy to use (e.g. assuming 1 → true, 0 → false, -1 → not initialized). This is also nice for interfacing with foreign languages, because I can avoid compatibility issues with boolean types in other languages.

(But a slight downside of this approach may be that, to use it for existing codes, I have to modify if statements and namelist I/O etc manually. It is of course no problem for new codes if I assume integer variables from the beginning, though.)

Another appealing option may be to define a custom boolean-like type. I will also consider this approach when necessary. (However, for namelist input, it may be somewhat awkward to detect whether the custom variable has been read from a file.)

Because logical variables typically have 4 bytes, I think there are a lot of “free space” for storing additional information. So, it may be nice if a new compiler can embed more information for free bits (?) somehow, to enable further check (such as user initialization) at the compiler level.


Just for fun, I have also searched the net to see how other languages might deal with this problem. Though I’ve never used it, Nullable might provide such utility for value types (though not very sure…)

Primitive types such as integers and Booleans cannot generally be null, but the corresponding nullable types (nullable integer and nullable Boolean, respectively) can also assume the NULL value. This can be represented in ternary logic as FALSE,NULL,TRUE as in three-valued logic.


Another interesting feature I came across is alias this in the D language, which allows to define a boolean-like custom type that can be used without modifying existing codes (while allowing to have additional fields to check initialization, for example). An example code may be like this (Compiler Explorer here):

struct Mybool
{
    bool myflag = true;

    alias myflag this;  // forward any access to "myflag" by default
    bool inited = false;
}

void main()
{
    import std.stdio;

    Mybool b;  // custom boolean variable

    writeln( "b        = ", b );  // can be output directly
    writeln( "b.myflag = ", b.myflag );
    writeln( "b.inited = ", b.inited );

    if (   b ) writeln( "(b = true)" );  // can be tested directly
    if ( ! b ) writeln( "(b = false)" );

    assert( b.inited );  // raises error because b is not inited
    writeln( "ok" );
}

$ gdc-11 test.d && ./a.out
b        = true
b.myflag = true
b.inited = false
(b = true)
core.exception.AssertError@test.d(28): Assertion failure

You could initialize logical variables randomly or based on the current time in seconds, as in the code below, and check that multiple runs of the program give the same results.

module m
contains
function random_logical() result(tf)
real :: x
logical :: tf
call random_number(x)
tf = x > 0.5
end function
end module m
!
program main
use m
implicit none
logical :: tf
call random_seed()
tf = random_logical()
print*,tf
! time() is a gfortran extension. Could use date_and_time()
tf  = mod(time(), 2) == 1
print*,tf
end program main
1 Like

Hmm…, I am afraid my explanation of the original problem is not clear enough. In my case, I wished to have some deterministic state (value) representing that "the user did not specify its value explicitly before use ", so as to avoid any assumption of the value (e.g. in initialization), rather than “create a random state of a logical variable that varies from run to run” (which the above code seems to try to achieve). And yes, in the latter case I think the above code will be nice and sufficient.

EDIT: Sorry…, I am afraid I may have misunderstood the intent of the above code. The purpose may be to guarantee that the logical variable has some well-defined state (rather than dummy values), by artificially setting it to random values.

@septc might wish to allow more than +1,0,-1 so as to allow for modal logic, e.g. with
necessarily true > true > possibly true >= possibly false > false > necessarily false

At some point an integer is the practical solution, possibly with some predefined values.

integer, parameter :: VERY_FALSE = -2
integer, parameter :: FALSE = -1
integer, parameter :: MAYBE_FALSE = 0
integer, parameter :: MAYBE_TRUE = 0
integer, parameter :: TRUE = 1
integer, parameter :: VERY_TRUE = 2
integer, parameter :: UNDEFINED = -huge(0)