PR modula2/114026 Incorrect location during for loop type checking

If a for loop contains an incompatible type expression between the
designator and the second expression then the location
used when generating the error message is set to token 0.
The bug is fixed by extending the range checking
InitForLoopBeginRangeCheck.  The range checking is processed after
all types, constants have been resolved (and converted into gcc
trees).  The range check will check for assignment compatibility
between des and expr1, expression compatibility between des and expr2.
Separate token positions for des, exp1, expr2 and by are stored in the
Range record and used to create virtual tokens if they are on the same
source line.

gcc/m2/ChangeLog:

	PR modula2/114026
	* gm2-compiler/M2GenGCC.mod (Import): Remove DisplayQuadruples.
	Remove DisplayQuadList.
	(MixTypesBinary): Replace check with overflowCheck.
	New variable typeChecking.
	Use GenQuadOTypetok to retrieve typeChecking.
	Use typeChecking to suppress error message.
	* gm2-compiler/M2LexBuf.def (MakeVirtual2Tok): New procedure
	function.
	* gm2-compiler/M2LexBuf.mod (MakeVirtualTok): Improve comment.
	(MakeVirtual2Tok): New procedure function.
	* gm2-compiler/M2Quads.def (GetQuadOTypetok): New procedure.
	* gm2-compiler/M2Quads.mod (QuadFrame): New field CheckType.
	(PutQuadO): Rewrite using PutQuadOType.
	(PutQuadOType): New procedure.
	(GetQuadOTypetok): New procedure.
	(BuildPseudoBy): Rewrite.
	(BuildForToByDo): Remove type checking.
	Add parameters e2, e2tok, BySym, bytok to
	InitForLoopBeginRange.
	Push the RangeId.
	(BuildEndFor): Pop the RangeId.
	Use GenQuadOTypetok to generate AddOp without type checking.
	Call PutRangeForIncrement with the RangeId and IncQuad.
	(GenQuadOtok): Rewrite using GenQuadOTypetok.
	(GenQuadOTypetok): New procedure.
	* gm2-compiler/M2Range.def (InitForLoopBeginRangeCheck):
	Rename d as des, e as expr.
	Add expr1, expr1tok, expr2, expr2tok, byconst, byconsttok
	parameters.
	(PutRangeForIncrement): New procedure.
	* gm2-compiler/M2Range.mod (Import): MakeVirtual2Tok.
	(Range): Add expr2, byconst, destok, exprtok, expr2tok,
	incrementquad.
	(InitRange): Initialize expr2 to NulSym.
	Initialize byconst to NulSym.
	Initialize tokenNo, destok, exprtok, expr2tok, byconst to
	UnknownTokenNo.
	Initialize incrementquad to 0.
	(PutRangeForIncrement): New procedure.
	(PutRangeDesExpr2): New procedure.
	(InitForLoopBeginRangeCheck): Rewrite.
	(ForLoopBeginTypeCompatible): New procedure function.
	(CodeForLoopBegin): Call ForLoopBeginTypeCompatible and
	only code the for loop assignment if all the type checks
	succeed.

gcc/testsuite/ChangeLog:

	PR modula2/114026
	* gm2/extensions/run/pass/callingc10.mod: New test.
	* gm2/extensions/run/pass/callingc11.mod: New test.
	* gm2/extensions/run/pass/callingc9.mod: New test.
	* gm2/extensions/run/pass/strconst.def: New test.
	* gm2/pim/fail/forloop.mod: New test.
	* gm2/pim/pass/forloop2.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

6 files changed, 81 insertions, 0 deletions

diff --git a/gcc/testsuite/gm2/extensions/run/pass/callingc10.mod b/gcc/testsuite/gm2/extensions/run/pass/callingc10.mod
new file mode 100644
index 0000000..3a2d3e2
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/callingc10.mod
@@ -0,0 +1,16 @@
+MODULE callingc10 ;
+
+FROM cvararg IMPORT funcptr ;
+FROM SYSTEM IMPORT ADR ;
+
+BEGIN
+   IF funcptr (1, "hello", 5) = 1
+   THEN
+   END ;
+   IF funcptr (1, "hello" + " ", 6) = 1
+   THEN
+   END ;
+   IF funcptr (1, "hello" + " " + "world", 11) = 1
+   THEN
+   END
+END callingc10.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/callingc11.mod b/gcc/testsuite/gm2/extensions/run/pass/callingc11.mod
new file mode 100644
index 0000000..9b8cb82
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/callingc11.mod
@@ -0,0 +1,17 @@
+MODULE callingc11 ;
+
+FROM cvararg IMPORT funcptr ;
+FROM SYSTEM IMPORT ADR ;
+FROM strconst IMPORT WORLD ;
+
+BEGIN
+   IF funcptr (1, "hello", 5) = 1
+   THEN
+   END ;
+   IF funcptr (1, "hello" + " ", 6) = 1
+   THEN
+   END ;
+   IF funcptr (1, "hello" + " " + WORLD, 11) = 1
+   THEN
+   END
+END callingc11.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/callingc9.mod b/gcc/testsuite/gm2/extensions/run/pass/callingc9.mod
new file mode 100644
index 0000000..7e19a0a
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/callingc9.mod
@@ -0,0 +1,7 @@
+MODULE callingc9 ;
+
+VAR
+   array: ARRAY [0..9] OF CHAR ;
+BEGIN
+   array := '0123456789'
+END callingc9.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/strconst.def b/gcc/testsuite/gm2/extensions/run/pass/strconst.def
new file mode 100644
index 0000000..af1111c
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/strconst.def
@@ -0,0 +1,6 @@
+DEFINITION MODULE FOR "C" strconst ;
+
+CONST
+   WORLD = "world" ;
+
+END strconst.
diff --git a/gcc/testsuite/gm2/pim/fail/forloop.mod b/gcc/testsuite/gm2/pim/fail/forloop.mod
new file mode 100644
index 0000000..be86a84
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/forloop.mod
@@ -0,0 +1,17 @@
+MODULE forloop ;
+
+
+PROCEDURE init ;
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   c := 10 ;
+   FOR i := 0 TO c DO   (* INTEGER CARDINAL expression incompatible.  *)
+   END
+END init ;
+
+
+BEGIN
+   init
+END forloop.
diff --git a/gcc/testsuite/gm2/pim/pass/forloop2.mod b/gcc/testsuite/gm2/pim/pass/forloop2.mod
new file mode 100644
index 0000000..0bbc95d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/forloop2.mod
@@ -0,0 +1,18 @@
+MODULE forloop2 ;
+
+TYPE
+   colour = (red, green, blue) ;
+
+
+PROCEDURE init ;
+VAR
+   c: colour ;
+BEGIN
+   FOR c := red TO blue DO
+   END
+END init ;
+
+
+BEGIN
+   init
+END forloop2.