[PATCH] PR modula2/120542: Return statement in the main procedure crashes the compiler

The patch checks whether a return statement is allowed.  It also checks
to see that a return expression is allowed.

gcc/m2/ChangeLog:

	PR modula2/120542
	* gm2-compiler/M2Quads.mod (BuildReturnLower): New procedure.
	(BuildReturn): Allow return without an expression from
	module initialization blocks.  Generate an error if an
	expression is provided.  Call BuildReturnLower if no error
	was seen.

gcc/testsuite/ChangeLog:

	PR modula2/120542
	* gm2/iso/fail/badreturn.mod: New test.
	* gm2/iso/fail/badreturn2.mod: New test.
	* gm2/iso/pass/modulereturn.mod: New test.
	* gm2/iso/pass/modulereturn2.mod: New test.

(cherry picked from commit 16ab791531ec16fd4596a25efbe6b42e6c16171f)

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

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3c29fdd3b2ba7f621df4b804411bd9bb95cfacfb..b5455d09c66fd668fce48e46d68ccdea9b669138 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -11298,6 +11298,35 @@ BEGIN
 END CheckReturnType ;
 
 
+(*
+   BuildReturnLower - check the return type and value to ensure type
+                      compatibility and no range overflow will occur.
+*)
+
+PROCEDURE BuildReturnLower (tokcombined, tokexpr: CARDINAL; e1, t1: CARDINAL) ;
+VAR
+   e2, t2: CARDINAL ;
+BEGIN
+   (* This will check that the type returned is compatible with
+      the formal return type of the procedure.  *)
+   CheckReturnType (tokcombined, CurrentProc, e1, t1) ;
+   (* Dereference LeftValue if necessary.  *)
+   IF GetMode (e1) = LeftValue
+   THEN
+      t2 := GetSType (CurrentProc) ;
+      e2 := MakeTemporary (tokexpr, RightValue) ;
+      PutVar(e2, t2) ;
+      CheckPointerThroughNil (tokexpr, e1) ;
+      doIndrX (tokexpr, e2, e1) ;
+      e1 := e2
+   END ;
+   (* Here we check the data contents to ensure no overflow.  *)
+   BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e1)) ;
+   GenQuadOtok (tokcombined, ReturnValueOp, e1, NulSym, CurrentProc, FALSE,
+                tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc))
+END BuildReturnLower ;
+
+
 (*
    BuildReturn - Builds the Return part of the procedure.
                  tokreturn is the location of the RETURN keyword.
@@ -11317,7 +11346,6 @@ PROCEDURE BuildReturn (tokreturn: CARDINAL) ;
 VAR
    tokcombined,
    tokexpr    : CARDINAL ;
-   e2, t2,
    e1, t1,
    t, f,
    Des        : CARDINAL ;
@@ -11337,26 +11365,18 @@ BEGIN
    tokcombined := MakeVirtualTok (tokreturn, tokreturn, tokexpr) ;
    IF e1 # NulSym
    THEN
-      (* this will check that the type returned is compatible with
-         the formal return type of the procedure.  *)
-      CheckReturnType (tokcombined, CurrentProc, e1, t1) ;
-      (* dereference LeftValue if necessary *)
-      IF GetMode (e1) = LeftValue
-      THEN
-         t2 := GetSType (CurrentProc) ;
-         e2 := MakeTemporary (tokexpr, RightValue) ;
-         PutVar(e2, t2) ;
-         CheckPointerThroughNil (tokexpr, e1) ;
-         doIndrX (tokexpr, e2, e1) ;
-        (* here we check the data contents to ensure no overflow.  *)
-         BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e2)) ;
-         GenQuadOtok (tokcombined, ReturnValueOp, e2, NulSym, CurrentProc, FALSE,
-                      tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc))
+      (* Check we are in a procedure scope and that the procedure has a return type.  *)
+      IF CurrentProc = NulSym
+      THEN
+         MetaErrorT0 (tokcombined,
+                      '{%1E} attempting to return a value when not in a procedure scope')
+      ELSIF GetSType (CurrentProc) = NulSym
+      THEN
+         MetaErrorT1 (tokcombined,
+                      'attempting to return a value from procedure {%1Ea} which does not have a return type',
+                     CurrentProc)
       ELSE
-        (* here we check the data contents to ensure no overflow.  *)
-         BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e1)) ;
-         GenQuadOtok (tokcombined, ReturnValueOp, e1, NulSym, CurrentProc, FALSE,
-                      tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc))
+         BuildReturnLower (tokcombined, tokexpr, e1, t1)
       END
    END ;
    GenQuadO (tokcombined, GotoOp, NulSym, NulSym, PopWord (ReturnStack), FALSE) ;

diff --git a/gcc/testsuite/gm2/iso/fail/badreturn.mod b/gcc/testsuite/gm2/iso/fail/badreturn.mod
new file mode 100644 (file)
index 0000000..5417961
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badreturn.mod
@@ -0,0 +1,5 @@
+MODULE badreturn ;
+
+BEGIN
+   RETURN 0
+END badreturn.
\ No newline at end of file

diff --git a/gcc/testsuite/gm2/iso/fail/badreturn2.mod b/gcc/testsuite/gm2/iso/fail/badreturn2.mod
new file mode 100644 (file)
index 0000000..a4b9008
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badreturn2.mod
@@ -0,0 +1,12 @@
+MODULE badreturn2 ;
+
+
+PROCEDURE foo ;
+BEGIN
+   RETURN 0
+END foo ;
+
+
+BEGIN
+   foo
+END badreturn2.

diff --git a/gcc/testsuite/gm2/iso/pass/modulereturn.mod b/gcc/testsuite/gm2/iso/pass/modulereturn.mod
new file mode 100644 (file)
index 0000000..b39947d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/modulereturn.mod
@@ -0,0 +1,5 @@
+MODULE modulereturn ;
+
+BEGIN
+   RETURN
+END modulereturn.

diff --git a/gcc/testsuite/gm2/iso/pass/modulereturn2.mod b/gcc/testsuite/gm2/iso/pass/modulereturn2.mod
new file mode 100644 (file)
index 0000000..934cfae
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/modulereturn2.mod
@@ -0,0 +1,10 @@
+MODULE modulereturn2 ;
+
+
+BEGIN
+   RETURN
+EXCEPT
+   RETURN
+FINALLY
+   RETURN
+END modulereturn2.