Undefined behavior due to nested procedure

[tenko]

Consider the following code (simplified larger module):

MODULE Test;
IMPORT Out;

TYPE
    TEST = 
    RECORD
        title : ARRAY 64 OF CHAR;
        tests : LONGINT
    END;
   
VAR
    test : TEST;  

PROCEDURE Length(str: ARRAY OF CHAR) : INTEGER;
VAR i: INTEGER;
BEGIN
    i := 0;
    WHILE (i < LEN(str)) & (str[i] # 00X) DO INC(i) END;
    RETURN i
END Length;

PROCEDURE FillString(VAR s : ARRAY OF CHAR);
VAR   
   i : INTEGER;
BEGIN
   i := 0;
   WHILE i < LEN(s) DO
      s[i] := CHR(SHORT(i MOD 20) + 65);
      INC(i)
   END
END FillString;

PROCEDURE Run1(VAR test: TEST);
VAR   
    str : ARRAY 257 OF CHAR;
BEGIN
    str := "test";
    Out.String("1.1 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
    FillString(str);
    Out.String("1.2 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
END Run1;

PROCEDURE Run2(VAR test: TEST);
VAR   
    str : ARRAY 257 OF CHAR;
    PROCEDURE Assert(b: BOOLEAN);
    BEGIN
        ASSERT(b)
    END Assert;
BEGIN
    str := "test";
    Out.String("2.1 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
    FillString(str);
    Out.String("2.2 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
END Run2;

PROCEDURE Run3(VAR test: TEST);
VAR   
    str : ARRAY 257 OF CHAR;
    i : LONGINT;
    res : BOOLEAN;
BEGIN
    str := "test";
    Out.String("3.1 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
    FillString(str);
    Out.String("3.2 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
END Run3;

BEGIN
    Run1(test);
    Run2(test);
    Run2(test)
END Test.

This outputs unexpected result:

1.1 : Length(str) = 4
1.2 : Length(str) = 257
2.1 : Length(str) = 257
2.2 : Length(str) = 257
2.1 : Length(str) = 257
2.2 : Length(str) = 257

[zaskar9]

I simplified the module even further, removing the TYPE declaration, some local variables, and the VAR parameters of the three Run procedures.

MODULE Issue37;
IMPORT Out;

PROCEDURE Length(str: ARRAY OF CHAR) : INTEGER;
VAR i: INTEGER;
BEGIN
    i := 0;
    WHILE (i < LEN(str)) & (str[i] # 00X) DO INC(i) END;
    RETURN i
END Length;

PROCEDURE FillString(VAR s : ARRAY OF CHAR);
VAR
   i : INTEGER;
BEGIN
   i := 0;
   WHILE i < LEN(s) DO
      s[i] := CHR(SHORT(i MOD 20) + 65);
      INC(i)
   END
END FillString;

PROCEDURE Run1();
VAR
    str : ARRAY 257 OF CHAR;
BEGIN
    str := "test";
    Out.String("1.1 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
    FillString(str);
    Out.String("1.2 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
END Run1;

PROCEDURE Run2();
VAR
    str : ARRAY 257 OF CHAR;
    PROCEDURE Assert(b: BOOLEAN);
    BEGIN
        ASSERT(b)
    END Assert;
BEGIN
    str := "test";
    Out.String("2.1 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
    FillString(str);
    Out.String("2.2 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
END Run2;

PROCEDURE Run3();
VAR
    str : ARRAY 257 OF CHAR;
BEGIN
    str := "test";
    Out.String("3.1 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
    FillString(str);
    Out.String("3.2 : Length(str) = "); Out.Int(Length(str), 0); Out.Ln;
END Run3;

BEGIN
    Run1();
    Run2();
    Run2()
END Issue37.

The erroneous behavior is still present, but actually not linked to VAR parameters. Instead the culprit seems to be (again) the unnesting of procedure Assert. From the debug output of the unnested module, I cannot immediately see what's going wrong. I will have to look into this in more detail on the weekend. This week the teaching resumed at my university and, therefore, I have even less time for the side project that is oberon-lang. Nevertheless, I am grateful for bugs being hunted down!

[tenko]

Excellent. The work around is simple, so not a pressing issue.
I have a large (500+ tests) testsuite from my Oberon-2 library I try to port over and discover this by
running against known good output. I will report any issues I find.

[zaskar9]

Closed by #39

[tenko]

The following code gives different result depending on if the functions is nested or not:

MODULE Test;
IMPORT Out;

PROCEDURE IsLower (ch: CHAR) : BOOLEAN;
BEGIN RETURN (ch >= "a") & (ch <= "z")
END IsLower;

PROCEDURE Upper(ch: CHAR) : CHAR;
BEGIN
    IF IsLower(ch) THEN RETURN CHR(ORD(ch) + (ORD("A") - ORD("a"))) END;
    RETURN ch
END Upper;

PROCEDURE Length(str: ARRAY OF CHAR) : INTEGER;
VAR i: INTEGER;
BEGIN
    i := 0;
    WHILE (i < LEN(str)) & (str[i] # 00X) DO INC(i) END;
    RETURN i
END Length;

PROCEDURE IMatch1(str, pattern : ARRAY OF CHAR; IgnoreCase : BOOLEAN; is, ip: LONGINT): BOOLEAN;
VAR
    lens, lenp : LONGINT;
BEGIN
    lens := Length(str);
    lenp := Length(pattern);
    WHILE ip < lenp DO
        IF pattern[ip] = "*" THEN
            WHILE is <= lens DO (* check to end of string *)
                IF IMatch1(str, pattern, IgnoreCase, is, ip + 1) THEN RETURN TRUE END;
                INC(is)
            END;
            RETURN FALSE
        ELSIF is = lens THEN (* pattern not exhausted *)
            RETURN FALSE
        ELSIF pattern[ip] = "?" THEN
        ELSIF ~IgnoreCase & (str[is] # pattern[ip]) THEN
            RETURN FALSE
        ELSIF IgnoreCase & (Upper(str[is]) # Upper(pattern[ip])) THEN
            RETURN FALSE
        END;
        INC(is); INC(ip)
    END;
    RETURN is = lens
END IMatch1;
PROCEDURE Match1 (str, pattern : ARRAY OF CHAR; IgnoreCase : BOOLEAN): BOOLEAN;
BEGIN
    IF Length(pattern) = 0 THEN RETURN Length(str) = 0 END;
    RETURN IMatch1(str, pattern, IgnoreCase, 0, 0)
END Match1;

PROCEDURE Match2 (str, pattern : ARRAY OF CHAR; IgnoreCase : BOOLEAN): BOOLEAN;
    PROCEDURE IMatch(str, pattern : ARRAY OF CHAR; IgnoreCase : BOOLEAN; is, ip: LONGINT): BOOLEAN;
    VAR
        lens, lenp : LONGINT;
    BEGIN
        lens := Length(str);
        lenp := Length(pattern);
        WHILE ip < lenp DO
            IF pattern[ip] = "*" THEN
                WHILE is <= lens DO (* check to end of string *)
                    IF IMatch(str, pattern, IgnoreCase, is, ip + 1) THEN RETURN TRUE END;
                    INC(is)
                END;
                RETURN FALSE
            ELSIF is = lens THEN (* pattern not exhausted *)
                RETURN FALSE
            ELSIF pattern[ip] = "?" THEN
            ELSIF ~IgnoreCase & (str[is] # pattern[ip]) THEN
                RETURN FALSE
            ELSIF IgnoreCase & (Upper(str[is]) # Upper(pattern[ip])) THEN
                RETURN FALSE
            END;
            INC(is); INC(ip)
        END;
        RETURN is = lens
    END IMatch;
BEGIN
    IF Length(pattern) = 0 THEN RETURN Length(str) = 0 END;
    RETURN IMatch(str, pattern, IgnoreCase, 0, 0)
END Match2;

BEGIN
    Out.String("Match1('Filename.exe', 'f?l*.exe', FALSE) = "); Out.Int(ORD(Match1("Filename.exe", "f?l*.exe", FALSE)), 0); Out.Ln;
    Out.String("Match2('Filename.exe', 'f?l*.exe', FALSE) = "); Out.Int(ORD(Match2("Filename.exe", "f?l*.exe", FALSE)), 0); Out.Ln
END Test.

This outputs:

Match1('Filename.exe', 'f?l*.exe', FALSE) = 0
Match2('Filename.exe', 'f?l*.exe', FALSE) = 1

[zaskar9]

Those nested procedures should be outlawed! 😎 But fine, I'll reopen the issue and have a look in what corner of LambdaLifter the bugs are hiding!

[zaskar9]

I take it back! LambdaLifter is not to blame! The problem is in the code generator that does not support what LambdaLifter is asking it to do.

tl;dr

When unnesting procedures, LambdaLifter creates a record with all parameters and local variables of the super-procedure in order to pass its environment as an extra parameter to the sub-procedure. For the procedure Match2, the following environment type is created by LambdaLifter.

TYPE _TMatch2(*Scope:1*) = RECORD str: ARRAY OF CHAR; pattern: ARRAY OF CHAR; IgnoreCase: BOOLEAN END(*Size:1*);

While this type is correct, it relies on functionality that I have not yet introduced in the backend. Since open array types cannot be used for variables and record fields, a programmer could not explicitly create this type. Already the parser would not accept it. Obviously (and thanks for finding that loophole), I overlooked that open arrays will be used in this way internally by LambdaLifter.

To fix the problem, I will add support for variables and record fields with an open array type by allocating them as pointers and checking that they are stored and loaded correctly in the LLVM-IR. However, I think it makes sense to defer upgrading the Parser and Sema to support this functionality as I consider it to be extended functionality that goes beyond the standard Oberon. At the moment my priorities are fixing bugs and closing the remaining gaps to support all of standard Oberon (e.g., record extensions, function pointers, CASE statement, etc.).

[tenko]

I agree.

Here we have a known reproducible "weird" case which can be deferred until later when more important issues are solved.
The workaround is very simple in this case.

I found this when porting code from my XDS library and have now about 170 tests passed.
I will port over more code with unittests and report back any findings.