Assignment

Assignment statement, a statement (stmt) node.

Declaration

Syntax

Assignment(expr target, expr value, stmt? overloaded, bool realloc_lhs, bool move_allocation)

Arguments

target contains expression target. value expressions giving the value to be assigned. overloaded denotes if overloaded. realloc_lhs denotes if target has to be reallocated to the size of value before the assignment. move_allocation denotes if this is a move assignment for allocatable arrays.

Return values

None.

Description

assignment statement assigns a value to a variable, substring, array element, record, or record field.

The value can be a constant or the result of an expression. The kinds of assignment statements: are arithmetic, logical, character, and record assignments.

If realloc_lhs is true then before the assignment the target is reallocated to the size of the value.

move_allocation must only be true if both target and value are allocatable arrays of DescriptorArray physical type. The data pointer of value’s descriptor is copied to the target’s descriptor. And rest of the fields of value’s descriptor are copied into target’s descriptor. After the move, the data pointer of value’s descriptor is set to null.

Types

Numeric type, a name of a variable, array element, or record field. Arithmentic expression, chracter constant, or a logical expression.

Examples

module overload_assignment_m
    implicit none
    private
    public assignment (=)

    interface assignment (=)
        module procedure logical_gets_integer
    end interface
contains
    subroutine logical_gets_integer(tf, i)
        logical, intent (out) :: tf
        integer, intent (in)  :: i

        tf = (i == 0)
    end subroutine

    subroutine logical_gets_integer_use(tf, i)
        logical, intent (out) :: tf
        integer, intent (in)  :: i

        tf = i
    end subroutine
end module

program main
    use overload_assignment_m, only: assignment(=)
    implicit none
    logical :: tf

    tf = 0
    print *, "tf=0:", tf  ! Yields: T
    tf = 1
    print *, "tf=1:", tf  ! Yields: F
end program

ASR:

(TranslationUnit
    (SymbolTable
        1
        {
            main:
                (Program
                    (SymbolTable
                        5
                        {
                            logical_gets_integer@~assign:
                                (ExternalSymbol
                                    5
                                    logical_gets_integer@~assign
                                    2 logical_gets_integer
                                    overload_assignment_m
                                    []
                                    logical_gets_integer
                                    Private
                                ),
                            tf:
                                (Variable
                                    5
                                    tf
                                    Local
                                    ()
                                    ()
                                    Default
                                    (Logical 4 [])
                                    Source
                                    Private
                                    Required
                                    .false.
                                ),
                            ~assign:
                                (ExternalSymbol
                                    5
                                    ~assign
                                    2 ~assign
                                    overload_assignment_m
                                    []
                                    ~assign
                                    Private
                                )

                        })
                    main
                    [overload_assignment_m]
                    [(=
                        (Var 5 tf)
                        (IntegerConstant 0 (Integer 4 []))
                        (SubroutineCall
                            5 logical_gets_integer@~assign
                            5 ~assign
                            [((Var 5 tf))
                            ((IntegerConstant 0 (Integer 4 [])))]
                            ()
                        )
                    )
                    (Print
                        ()
                        [(StringConstant
                            "tf=0:"
                            (Character 1 5 () [])
                        )
                        (Var 5 tf)]
                        ()
                        ()
                    )
                    (=
                        (Var 5 tf)
                        (IntegerConstant 1 (Integer 4 []))
                        (SubroutineCall
                            5 logical_gets_integer@~assign
                            5 ~assign
                            [((Var 5 tf))
                            ((IntegerConstant 1 (Integer 4 [])))]
                            ()
                        )
                    )
                    (Print
                        ()
                        [(StringConstant
                            "tf=1:"
                            (Character 1 5 () [])
                        )
                        (Var 5 tf)]
                        ()
                        ()
                    )]
                ),
            overload_assignment_m:
                (Module
                    (SymbolTable
                        2
                        {
                            logical_gets_integer:
                                (Function
                                    (SymbolTable
                                        3
                                        {
                                            i:
                                                (Variable
                                                    3
                                                    i
                                                    In
                                                    ()
                                                    ()
                                                    Default
                                                    (Integer 4 [])
                                                    Source
                                                    Private
                                                    Required
                                                    .false.
                                                ),
                                            tf:
                                                (Variable
                                                    3
                                                    tf
                                                    Out
                                                    ()
                                                    ()
                                                    Default
                                                    (Logical 4 [])
                                                    Source
                                                    Private
                                                    Required
                                                    .false.
                                                )

                                        })
                                    logical_gets_integer
                                    [(Var 3 tf)
                                    (Var 3 i)]
                                    [(=
                                        (Var 3 tf)
                                        (IntegerCompare
                                            (Var 3 i)
                                            Eq
                                            (IntegerConstant 0 (Integer 4 []))
                                            (Logical 4 [])
                                            ()
                                        )
                                        ()
                                    )]
                                    ()
                                    Source
                                    Private
                                    Implementation
                                    ()
                                    .false.
                                    .false.
                                    .false.
                                    .false.
                                    .false.
                                    []
                                    []
                                    .false.
                                ),
                            logical_gets_integer_use:
                                (Function
                                    (SymbolTable
                                        4
                                        {
                                            i:
                                                (Variable
                                                    4
                                                    i
                                                    In
                                                    ()
                                                    ()
                                                    Default
                                                    (Integer 4 [])
                                                    Source
                                                    Private
                                                    Required
                                                    .false.
                                                ),
                                            tf:
                                                (Variable
                                                    4
                                                    tf
                                                    Out
                                                    ()
                                                    ()
                                                    Default
                                                    (Logical 4 [])
                                                    Source
                                                    Private
                                                    Required
                                                    .false.
                                                )

                                        })
                                    logical_gets_integer_use
                                    [(Var 4 tf)
                                    (Var 4 i)]
                                    [(=
                                        (Var 4 tf)
                                        (Var 4 i)
                                        (SubroutineCall
                                            2 logical_gets_integer
                                            2 ~assign
                                            [((Var 4 tf))
                                            ((Var 4 i))]
                                            ()
                                        )
                                    )]
                                    ()
                                    Source
                                    Private
                                    Implementation
                                    ()
                                    .false.
                                    .false.
                                    .false.
                                    .false.
                                    .false.
                                    []
                                    []
                                    .false.
                                ),
                            ~assign:
                                (CustomOperator
                                    2
                                    ~assign
                                    [2 logical_gets_integer]
                                    Public
                                )

                        })
                    overload_assignment_m
                    []
                    .false.
                    .false.
                )

        })
    []
)

See Also