https://gcc.gnu.org/g:16ab791531ec16fd4596a25efbe6b42e6c16171f
commit r16-1251-g16ab791531ec16fd4596a25efbe6b42e6c16171f
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Fri Jun 6 10:46:48 2025 +0100
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.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Quads.mod | 60 ++++++++++++++++++----------
gcc/testsuite/gm2/iso/fail/badreturn.mod | 5 +++
gcc/testsuite/gm2/iso/fail/badreturn2.mod | 12 ++++++
gcc/testsuite/gm2/iso/pass/modulereturn.mod | 5 +++
gcc/testsuite/gm2/iso/pass/modulereturn2.mod | 10 +++++
5 files changed, 72 insertions(+), 20 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3c29fdd3b2ba..b5455d09c66f 100644
--- 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
index 000000000000..54179611eccd
--- /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
index 000000000000..a4b90085f1f3
--- /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
index 000000000000..b39947d37200
--- /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
index 000000000000..934cfae79020
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/modulereturn2.mod
@@ -0,0 +1,10 @@
+MODULE modulereturn2 ;
+
+
+BEGIN
+ RETURN
+EXCEPT
+ RETURN
+FINALLY
+ RETURN
+END modulereturn2.
