Allow Revised Oberon array assignment (source may be shorter than target).

This commit is contained in:
David Brown 2016-12-01 17:57:27 +00:00
parent b16e82f866
commit aed9134e99
4 changed files with 20 additions and 17 deletions

View file

@ -891,20 +891,26 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF x^.comp = OPT.Array THEN
IF (ynode^.class = OPT.Nconst) & (g = OPT.Char) THEN CharToString(ynode); y := ynode^.typ; g := OPT.String END ;
IF x = y THEN (* ok *)
ELSIF (y.comp = OPT.Array) & (y.BaseTyp = x.BaseTyp) & (y.n <= x.n) THEN (* OK by Oberon-07/2013 *)
ELSIF (y.comp = OPT.DynArr) & (y.BaseTyp = x.BaseTyp) THEN (* OK by Oberon-07/2013, length tested at runtime *)
ELSIF x^.BaseTyp = OPT.chartyp THEN (* Assign to (static) ARRAY OF CHAR *)
IF g = OPT.String THEN (*check length of string*)
IF ynode^.conval^.intval2 > x^.n THEN err(114) END
(* Todo: implement Oberon-07/2013 array assignment
ELSIF (y.comp IN {OPT.DynArr, OPT.Array}) & (y.BaseTyp = OPT.chartyp) THEN
(* Assignment from ARRAY OF CHAR is good.*)
*)
ELSE err(113)
END
ELSE err(113)
END
(* Todo: implement Oberon-07/2013 array assignment
ELSIF (x.comp = OPT.DynArr) & (x^.BaseTyp = OPT.chartyp) THEN (* Assign to dynamic ARRAY OF CHAR*)
IF (y.comp IN {OPT.DynArr, OPT.Array}) & (y.BaseTyp = OPT.chartyp) THEN
(* Assignment from ARRAY OF CHAR is good.*)
ELSE err(113)
END
*)
ELSIF x^.comp = OPT.Record THEN
IF x = y THEN (* ok *)
ELSIF y^.comp = OPT.Record THEN
@ -913,7 +919,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF q = NIL THEN err(113) END
ELSE err(113)
END
ELSE err(113)
ELSE (* Assign to dynamic array *) err(113)
END
ELSE OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
END ;
@ -1464,7 +1470,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Return;
PROCEDURE Assign*(VAR x: OPT.Node; y: OPT.Node);
VAR z: OPT.Node; subcl: SHORTINT;
VAR z: OPT.Node;
BEGIN
IF x^.class >= OPT.Nconst THEN err(56) END ;
CheckAssign(x^.typ, y);
@ -1481,15 +1487,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
(y^.typ^.form = OPT.String) & (y^.conval^.intval2 = 1) THEN (* replace array := "" with array[0] := 0X *)
y^.typ := OPT.chartyp; y^.conval^.intval := 0;
Index(x, NewIntConst(0))
END ;
IF (x.typ.comp IN {OPT.Array, OPT.DynArr}) & (x.typ.BaseTyp = OPT.chartyp)
& (y.typ.comp IN {OPT.Array, OPT.DynArr}) & (y.typ.BaseTyp = OPT.chartyp) THEN
subcl := OPT.copyfn
ELSE
subcl := OPT.assign
END;
BindNodes(OPT.Nassign, OPT.notyp, x, y);
x^.subcl := subcl;
x^.subcl := OPT.assign;
END Assign;
PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct);

View file

@ -785,8 +785,17 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString(MoveFunc);
expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma);
IF r^.typ = OPT.stringtyp THEN OPM.WriteInt(r^.conval^.intval2)
ELSE OPM.WriteInt(r^.typ^.size)
END ;
ELSIF r.typ.comp = OPT.DynArr THEN
(* Dynamic array to array copy *)
OPM.WriteString("__X(");
OPC.Len(r.obj, r.typ, 0); OPM.WriteString(" * "); OPM.WriteInt(r.typ.BaseTyp.size);
OPM.WriteString(", ");
OPM.WriteInt(l.typ.size);
OPM.Write(")")
ELSE (* Array to array copy. *)
ASSERT(r.typ.comp = OPT.Array); ASSERT(r.typ.size <= l.typ.size);
OPM.WriteInt(r^.typ^.size)
END;
OPM.Write(CloseParen)
ELSE
IF (l^.typ^.form = OPT.Pointer) & (l^.obj # NIL) & (l^.obj^.adr = 1) & (l^.obj^.mode = OPT.Var) THEN

View file

@ -19,8 +19,5 @@ BEGIN
COPY(a30, a10); Console.String("a10: "); Console.String(a10); Console.Ln;
Console.String("a20: "); Console.String(a20); Console.Ln;
Console.Ln;
a10 := a30; Console.String("a10: "); Console.String(a10); Console.Ln;
Console.String("a20: "); Console.String(a20); Console.Ln;
Console.Ln;
Console.String("Array assignment test complete."); Console.Ln;
END aa.

View file

@ -4,7 +4,4 @@ a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
Array assignment test complete.