<div dir="ltr"><div>Andreas, <br></div><div><br></div><div>I remember reading about a similar issue related to the WITH statement of Oberon-90, so the way I solved this problem in oberonc is to add an additional type test each time the case variable is referred in the statements of a particular case label.</div><div>Test0 correctly fails at runtime once it is compiled by oberonc. See <a href="https://github.com/lboasso/oberonc/blob/master/src/OJG.Mod#L868">https://github.com/lboasso/oberonc/blob/master/src/OJG.Mod#L868</a> for the details in oberonc. </div><div><br></div><div>This would be equivalent to the following Oberon-07 code for MODULE Test0 where the reference of p0 is guarded by the label type <b>P1</b> each time it is used in the statements that follows.<br></div><div><br></div><div> <span style="font-family:monospace">PROCEDURE check0();<br>
BEGIN p0 := p1; (*sets the dynamic type of the global variable p0 to P1*)<br>
CASE p0 OF<br>
P1:<br>
AssignGlobal(); (*sets the dynamic type of p0 to P2*)<br>
p0<b>(P1)</b>.fld1 := 123; (*but the CASE stmt still thinks p0 is of type P1, but writes the data to p2.fld2*)<br>
END ;<br>
Texts.WriteInt(W, p2.fld2, 4); Texts.Append(Oberon.Log, W.buf) (*123!!*)<br>
END check0;</span></div><div><br></div><div>I know that one of the rationales of the WITH statement / CASE type was to pay for the dynamic type check <b>once</b> and avoid additional checks on the following statements/expressions, but this has always been a source of implementation bugs when VAR parameters are used.</div><div><br></div><div><br></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Fri, Oct 30, 2020 at 8:06 AM Andreas Pirklbauer <<a href="mailto:andreas_pirklbauer@yahoo.com">andreas_pirklbauer@yahoo.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">The official Oberon-07 compiler, as published at <a href="http://www.projectoberon.com" rel="noreferrer" target="_blank">www.projectoberon.com</a>,<br>
contains a serious type loophole in type case statements<br>
<br>
CASE x OF T0:.. | T1:.. END<br>
<br>
where x is a pointer or record VAR param and T0, T1.. are pointer or record types.<br>
<br>
For example, the test program Test0 below *compiles* without any error<br>
message, but leads to incorrect behaviour at run time. In this particular<br>
case, it is because the case variable p0 is a *global* variable with is assigned<br>
to a *different* global variable p2 of a *different* extension P2 *within* (!) the<br>
case statement. But the CASE statement still thinks p0 is of type P1, not P2...<br>
<br>
There are other situations, where type errors can occur at runtime. For<br>
example, if the case variable which is of a pointer type is passed as a<br>
VAR parameter to another procedure, which then modifies its dynamic<br>
type through an assignment within the procedure..<br>
<br>
I have therefore modified the Oberon-07 compiler (a little tricky, but<br>
doable with reasonable effort), such that it..<br>
<br>
now DISALLOWS...<br>
<br>
1. Global case variables p in a case statement CASE p OF .. END <br>
<br>
2. Assignments *to* case variables p *within* (the scope of) a CASE statement <br>
<br>
3. Passing a case variable p of type POINTER as a VAR parameter to a procedure P(p) <br>
<br>
but continues to ALLOW… <br>
<br>
1. Local variables or parameters (value or VAR) parameters as case variables<br>
<br>
2. Assignments to *fields* v.f of a case variable v<br>
(where v can be either a pointer or a record) <br>
<br>
3. Passing a case variable v as a *value* parameter to a procedure P(v),<br>
(where v can be either a pointer or a record) <br>
<br>
4. Passing a case variable r of type RECORD as a VAR parameter<br>
to a procedure P(r) (where the r must itself be a VAR parameter) <br>
<br>
I believe the above restrictions are acceptable. If not, one would<br>
have to tinker with the syntax of the type case statement itself.<br>
<br>
Below is a test program Test1 which - I believe - now produces the correct<br>
error messages (shown just below the test program Test1).<br>
<br>
The question is:<br>
~~~~~~~~~~~~~<br>
<br>
Are there any other cases one may need to consider, which could lead to type loop holes?<br>
<br>
<br>
-ap<br>
<br>
<br>
——————— module Test0 ———————————<br>
<br>
MODULE Test0;<br>
(* <br>
* The following module compiles under the regular Oberon-07 compiler <br>
* but has a type loophole at run time <br>
*)<br>
<br>
IMPORT Texts, Oberon;<br>
<br>
TYPE R0 = RECORD fld0: INTEGER END;<br>
R1 = RECORD (R0) fld1: INTEGER END ;<br>
R2 = RECORD (R0) fld2: INTEGER END ; (*same field offset as R1.fld1!*)<br>
P0 = POINTER TO R0;<br>
P1 = POINTER TO R1;<br>
P2 = POINTER TO R2;<br>
<br>
VAR p0: P0; p1: P1; p2: P2; r0: R0; r1: R1; r2: R2; W: Texts.Writer;<br>
<br>
PROCEDURE AssignGlobal();<br>
BEGIN p0 := p2<br>
END AssignGlobal;<br>
<br>
PROCEDURE check0();<br>
BEGIN p0 := p1; (*sets the dynamic type of the global variable p0 to P1*)<br>
CASE p0 OF<br>
P1:<br>
AssignGlobal(); (*sets the dynamic type of p0 to P2*)<br>
p0.fld1 := 123; (*but the CASE stmt still thinks p0 is of type P1, but writes the data to p2.fld2*)<br>
END ;<br>
Texts.WriteInt(W, p2.fld2, 4); Texts.Append(Oberon.Log, W.buf) (*123!!*)<br>
END check0;<br>
<br>
PROCEDURE Go*;<br>
BEGIN check0()<br>
END Go;<br>
<br>
BEGIN NEW(p0); NEW(p1); NEW(p2); Texts.OpenWriter(W)<br>
END Test0.<br>
<br>
ORP.Compile Test0.Mod/s ~<br>
System.Free Test0 ~<br>
Test0.Go<br>
<br>
When compiled with the official Oberon-07 compiler, there is no compile-time<br>
error, but an incorrect behaviour at run time (see description above)<br>
<br>
When compiled with the *modified* Oberon-07 compiler, the following error<br>
message is produced at compile time:<br>
<br>
OR Compiler 8.3.2020 / AP 6.8.20<br>
compiling Test0<br>
pos 664 global case variable not allowed<br>
compilation FAILED<br>
<br>
<br>
——————— module Test1 ———————————<br>
<br>
MODULE Test1;<br>
(* <br>
* The error messages below are produced by a modified Oberon-07 compiler <br>
* modifies the type case statement (CASE p OF T1... | T2... ) such that it <br>
* <br>
* Disallows... <br>
* <br>
* 1. Global case variables p in a case statement CASE p OF .. END <br>
* 2. Assignments *to* case variables p *within* (the scope of) a CASE statement <br>
* 3. Passing a case variable p of type POINTER as a VAR parameter to a procedure P(p) <br>
* <br>
* But contines to allow... <br>
* <br>
* 1. Local variables or parameters (value or VAR) parameters as case variables <br>
* 2. Assignments to *fields* p.f of a case variable p (either a pointer or record) <br>
* 3. Passing a case variable p as a *value* parameter to a procedure P(p) <br>
* 4. Passing a case variable r of type RECORD as a VAR parameter to a procedure P(r) <br>
* (note: the record r must itself be a VAR parameter in this case) <br>
*)<br>
<br>
TYPE R0 = RECORD fld0: INTEGER END;<br>
R1 = RECORD (R0) fld1: INTEGER END ;<br>
R2 = RECORD (R0) fld2: INTEGER END ; (*same field offset as R1.fld1!*)<br>
<br>
P0 = POINTER TO R0;<br>
P1 = POINTER TO R1;<br>
P2 = POINTER TO R2;<br>
<br>
VAR p0: P0; p1: P1; p2: P2; r0: R0; r1: R1; r2: R2;<br>
<br>
PROCEDURE AssignGlobal();<br>
BEGIN p0 := p2<br>
END AssignGlobal;<br>
<br>
PROCEDURE Proc1(p0: P0); BEGIN END Proc1;<br>
PROCEDURE Proc2(VAR p1: P1); BEGIN END Proc2;<br>
PROCEDURE Proc3(VAR r0: R0); BEGIN r0 := r2 END Proc3; (*projection*)<br>
PROCEDURE Proc4(VAR i: INTEGER); BEGIN END Proc4;<br>
PROCEDURE Proc5(b: BOOLEAN); BEGIN END Proc5;<br>
<br>
PROCEDURE check0();<br>
BEGIN p0 := p1; (*sets the dynamic type of the global variable p0 to P1*)<br>
CASE p0 OF (*ERROR "global case variable not allowed"*)<br>
P1:<br>
AssignGlobal(); (*if p were allowed to be global, the dynamic type of p0 would be set to P2 here*)<br>
p0.fld1 := 123 (*and therefore, there would be a type violation here, as the CASE stmt thinks p0 is still of type P1*)<br>
END ;<br>
END check0;<br>
<br>
<br>
PROCEDURE check1();<br>
VAR p, pa: P0;<br>
BEGIN p := p1; (*sets the dynamic type of the local variable p to P1*)<br>
CASE p OF<br>
P1:<br>
pa := p; (*allowed, since p is not modified*)<br>
Proc1(p); (*allowed, since p is passed as a value parameter*)<br>
Proc2(p); (*ERROR "read-only" -> not allowed, since p is passed as a VAR parameter*)<br>
Proc4(p.fld1); (*allowed, since a field of p, but not p itself is passed*)<br>
p := p2; (*ERROR "assignment not allowed" -> not allowed, since p is modified through an assignment*)<br>
p.fld1 := 123; (*guaranteed to be correct, since the runtime type of p cannot change inside CASE*)<br>
CASE pa OF (*nested case statement*)<br>
P1:<br>
Proc1(p); (*allowed, since p is passed as a value parameter*)<br>
Proc2(p) (*ERROR "read-only" -> not allowed, since p is passed as a VAR parameter*)<br>
END ;<br>
p := p1 (*ERROR "assignment not allowed" -> not allowed, since p is modified through an assignment*)<br>
END<br>
END check1;<br>
<br>
PROCEDURE check2();<br>
BEGIN p0 := p1; (*sets the dynamic type of the global variable p0 to P1*)<br>
IF p0 IS P1 THEN<br>
AssignGlobal(); (*the runtime type of p0 is not P1 anymore, but P2*)<br>
p0(P1).fld1 := 123; (*thereore, there (correctly) is a type guard failure (TRAP 2) at runtime*)<br>
END<br>
END check2;<br>
<br>
PROCEDURE check3(VAR r: R0);<br>
VAR rr: R1;<br>
BEGIN r := r1; (*allowed since pr is a VAR parameter (projection to fields of base type)*)<br>
CASE r OF<br>
R1:<br>
rr := r; (*allowed, since r itself is not modified*)<br>
r := r1; (*ERROR "assignment not allowed" -> not allowed, since r is modified through an assignment*)<br>
Proc3(r); (*allowed since r is a record passed as a VAR parameter*)<br>
r.fld1 := 234<br>
END<br>
END check3;<br>
<br>
PROCEDURE check4();<br>
VAR r: R1;<br>
BEGIN r := r1;<br>
CASE r OF (*ERROR "invalid type" -> not allowed since r is neither a pointer nor a VAR parameter*)<br>
R1: r.fld1 := 345<br>
END ;<br>
END check4;<br>
<br>
<br>
PROCEDURE check5(p: P0);<br>
BEGIN<br>
CASE p OF<br>
P1: Proc5(p IS P1)<br>
END<br>
END check5;<br>
<br>
PROCEDURE Go*;<br>
BEGIN<br>
check0();<br>
check1();<br>
check2();<br>
check3(r0);<br>
check4();<br>
check5(p0)<br>
END Go;<br>
<br>
BEGIN NEW(p0); NEW(p1); NEW(p2)<br>
END Test1.<br>
<br>
ORP.Compile Test1.Mod/s ~ # compiled with MODIFIED compiler<br>
<br>
OR Compiler 8.3.2020 / AP 6.8.20<br>
compiling Test1<br>
pos 1679 global case variable not allowed<br>
pos 2284 read-only<br>
pos 2456 assignment not allowed<br>
pos 2814 read-only<br>
pos 2916 assignment not allowed<br>
pos 3613 assignment not allowed<br>
pos 3910 invalid type<br>
pos 4011 not a constant<br>
compilation FAILED<br>
<br>
<br>
--<br>
<a href="mailto:Oberon@lists.inf.ethz.ch" target="_blank">Oberon@lists.inf.ethz.ch</a> mailing list for ETH Oberon and related systems<br>
<a href="https://lists.inf.ethz.ch/mailman/listinfo/oberon" rel="noreferrer" target="_blank">https://lists.inf.ethz.ch/mailman/listinfo/oberon</a><br>
</blockquote></div>