public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-5421] PR-108551 gcc/m2/gm2-libs-pim/Termbase.mod:128:1 error end of non-void
@ 2023-01-26 21:44 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-01-26 21:44 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:94673a121cfc7f9d51c9d05e31795477f4dc8dc7
commit r13-5421-g94673a121cfc7f9d51c9d05e31795477f4dc8dc7
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Thu Jan 26 21:43:22 2023 +0000
PR-108551 gcc/m2/gm2-libs-pim/Termbase.mod:128:1 error end of non-void
cc1gm2 generates an error: control reaches end of non-void function when
compiling Termbase.mod if -Werror=return-type is present.
../gcc/m2/gm2-libs-pim/Termbase.mod: In function 'Termbase_KeyPressed':
../gcc/m2/gm2-libs-pim/Termbase.mod:128:1: error: control reaches end
of non-void function [-Werror=return-type]
128 | END KeyPressed ;
| ^~~
This occurs as cc1gm2 does skips over the <* noreturn *> attribute. This
patch records the <* noreturn *> attribute in the m2 symbol table and
later on sets TREE_THIS_VOLATILE when creating the function decl.
The patch also contains a fix for the main scaffold which also omitted
a return 0 after the exception handler code.
gcc/m2/ChangeLog:
* gm2-compiler/M2GCCDeclare.mod: Import IsProcedureNoReturn.
(DeclareProcedureToGccWholeProgram): New variable declared and set
returnType. Pass returnType to BuildEndFunctionDeclaration.
Extra parameter IsProcedureNoReturn passed to
BuildEndFunctionDeclaration.
* gm2-compiler/M2Quads.mod (BuildM2MainFunction): Correct
scaffold comment and add extra return 0.
* gm2-compiler/P2Build.bnf: Import BuildNoReturnAttribute.
(ProcedureHeading): Process EndBuildFormalParameters before
parsing AttributeNoReturn.
(DefProcedureHeading): Process EndBuildFormalParameters before
parsing AttributeNoReturn.
(AttributeNoReturn): Call BuildNoReturnAttribute.
* gm2-compiler/P2SymBuild.def (BuildNoReturnAttribute): New
procedure.
* gm2-compiler/P2SymBuild.mod (BuildNoReturnAttribute): New
procedure.
* gm2-compiler/SymbolTable.def (PutProcedureInline): Corrected
comment.
(PutProcedureNoReturn): New procedure.
(IsProcedureNoReturn): New procedure function.
* gm2-compiler/SymbolTable.mod (SymProcedure): IsNoReturn
new field.
(MakeProcedure): Initialize IsNoReturn to FALSE.
(PutProcedureNoReturn): New procedure.
(IsProcedureNoReturn): New procedure function.
* gm2-gcc/m2decl.cc (m2decl_BuildEndFunctionDeclaration):
Add extra parameter isnoreturn. Set TREE_THIS_VOLATILE
to isnoreturn.
* gm2-gcc/m2decl.def (BuildEndFunctionDeclaration): Add
extra parameter isnoreturn.
* gm2-gcc/m2decl.h (m2decl_BuildEndFunctionDeclaration): Add
extra parameter isnoreturn.
* gm2-gcc/m2except.cc (m2except_InitExceptions): Change all
function decl to pass an extra parameter isnoreturn.
gcc/testsuite/ChangeLog:
* gm2/warnings/returntype/fail/badreturn.mod: New test.
* gm2/warnings/returntype/fail/warnings-returntype-fail.exp:
New test.
* gm2/warnings/returntype/pass/Termbase.mod: New test.
* gm2/warnings/returntype/pass/goodreturn.mod: New test.
* gm2/warnings/returntype/pass/keypressedsimple.mod: New test.
* gm2/warnings/returntype/pass/warnings-returntype-pass.exp:
New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 27 ++-
gcc/m2/gm2-compiler/M2Quads.mod | 4 +-
gcc/m2/gm2-compiler/P2Build.bnf | 11 +-
gcc/m2/gm2-compiler/P2SymBuild.def | 7 +
gcc/m2/gm2-compiler/P2SymBuild.mod | 12 ++
gcc/m2/gm2-compiler/SymbolTable.def | 18 +-
gcc/m2/gm2-compiler/SymbolTable.mod | 45 +++++
gcc/m2/gm2-gcc/m2decl.cc | 3 +-
gcc/m2/gm2-gcc/m2decl.def | 3 +-
gcc/m2/gm2-gcc/m2decl.h | 3 +-
gcc/m2/gm2-gcc/m2except.cc | 17 +-
.../gm2/warnings/returntype/fail/badreturn.mod | 11 ++
.../returntype/fail/warnings-returntype-fail.exp | 40 ++++
.../gm2/warnings/returntype/pass/Termbase.mod | 220 +++++++++++++++++++++
.../gm2/warnings/returntype/pass/goodreturn.mod | 13 ++
.../warnings/returntype/pass/keypressedsimple.mod | 21 ++
.../returntype/pass/warnings-returntype-pass.exp | 38 ++++
17 files changed, 463 insertions(+), 30 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 27745988c01..445c039a0c2 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -105,7 +105,7 @@ FROM SymbolTable IMPORT NulSym,
IsAModula2Type, UsesVarArgs,
GetSymName, GetParent,
GetDeclaredMod, GetVarBackEndType,
- GetProcedureBeginEnd,
+ GetProcedureBeginEnd, IsProcedureNoReturn,
GetString, GetStringLength, IsConstString,
IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
GetAlignment, IsDeclaredPacked, PutDeclaredPacked,
@@ -2347,6 +2347,7 @@ END IsExternalToWholeProgram ;
PROCEDURE DeclareProcedureToGccWholeProgram (Sym: CARDINAL) ;
VAR
+ returnType,
GccParam : Tree ;
scope,
Son,
@@ -2391,20 +2392,17 @@ BEGIN
PushBinding(scope) ;
IF GetSType(Sym)=NulSym
THEN
- PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
- KeyToCharStar(GetFullSymName(Sym)),
- NIL,
- IsExternalToWholeProgram(Sym),
- IsProcedureGccNested(Sym),
- IsExported(GetModuleWhereDeclared(Sym), Sym)))
+ returnType := NIL
ELSE
- PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
- KeyToCharStar(GetFullSymName(Sym)),
- Mod2Gcc(GetSType(Sym)),
- IsExternalToWholeProgram(Sym),
- IsProcedureGccNested(Sym),
- IsExported(GetModuleWhereDeclared(Sym), Sym)))
+ returnType := Mod2Gcc(GetSType(Sym))
END ;
+ PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
+ KeyToCharStar(GetFullSymName(Sym)),
+ returnType,
+ IsExternalToWholeProgram(Sym),
+ IsProcedureGccNested(Sym),
+ IsExported(GetModuleWhereDeclared(Sym), Sym),
+ IsProcedureNoReturn(Sym))) ;
PopBinding(scope) ;
WatchRemoveList(Sym, todolist) ;
WatchIncludeList(Sym, fullydeclared)
@@ -2481,7 +2479,8 @@ BEGIN
IsExternal (Sym), (* Extern relative to the main module. *)
IsProcedureGccNested (Sym),
(* Exported from the module where it was declared. *)
- IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym))) ;
+ IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym),
+ IsProcedureNoReturn(Sym))) ;
PopBinding(scope) ;
WatchRemoveList(Sym, todolist) ;
WatchIncludeList(Sym, fullydeclared)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 939758fed7a..3b6ed4531e9 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -2469,6 +2469,7 @@ BEGIN
}
catch (...) {
RTExceptions_DefaultErrorCatch ();
+ return 0;
}
}
*)
@@ -2492,10 +2493,11 @@ BEGIN
PushTtok (RequestSym (tokno, MakeKey ("envp")), tokno) ;
PushT (3) ;
BuildProcedureCall (tokno) ;
-
PushZero (tokno, Integer) ;
BuildReturn (tokno) ;
BuildExcept (tokno) ;
+ PushZero (tokno, Integer) ;
+ BuildReturn (tokno) ;
EndScope ;
BuildProcedureEnd ;
PopN (1)
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index ee2497b889d..ea5cfe73a5d 100644
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -97,6 +97,7 @@ FROM P2SymBuild IMPORT P2StartBuildProgramModule,
StartBuildProcedure,
EndBuildProcedure,
BuildFunction, BuildOptFunction,
+ BuildNoReturnAttribute,
BuildPointerType,
BuildRecord, BuildFieldRecord,
@@ -1025,8 +1026,8 @@ ProcedureHeading := "PROCEDURE" % M2E
% StartBuildProcedure %
% Assert(IsProcedure(OperandT(1))) %
% StartBuildFormalParameters %
- [ FormalParameters ] AttributeNoReturn
- % EndBuildFormalParameters %
+ [ FormalParameters ] % EndBuildFormalParameters %
+ AttributeNoReturn
% BuildProcedureHeading %
)
=:
@@ -1039,8 +1040,8 @@ DefProcedureHeading := "PROCEDURE" % M2E
% StartBuildProcedure %
% Assert(IsProcedure(OperandT(1))) %
% StartBuildFormalParameters %
- [ DefFormalParameters ] AttributeNoReturn
- % EndBuildFormalParameters %
+ [ DefFormalParameters ] % EndBuildFormalParameters %
+ AttributeNoReturn
% BuildProcedureHeading %
) % M2Error.LeaveErrorScope %
=:
@@ -1048,6 +1049,8 @@ DefProcedureHeading := "PROCEDURE" % M2E
AttributeNoReturn := [ "<*" % PushAutoOn %
Ident % PopAuto %
% checkReturnAttribute %
+ % Assert(IsProcedure(OperandT(1))) %
+ % BuildNoReturnAttribute (OperandT(1)) %
"*>" ] =:
AttributeUnused := [ "<*" % PushAutoOn %
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def b/gcc/m2/gm2-compiler/P2SymBuild.def
index d4fc693dd86..b377011c54a 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.def
+++ b/gcc/m2/gm2-compiler/P2SymBuild.def
@@ -863,6 +863,13 @@ PROCEDURE StartBuildProcedure ;
PROCEDURE EndBuildProcedure ;
+(*
+ BuildNoReturnAttribute - provide an interface to the symbol table module.
+*)
+
+PROCEDURE BuildNoReturnAttribute (procedureSym: CARDINAL) ;
+
+
(*
BuildPointerType - builds a pointer type.
The Stack:
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index cb80ccf2a9a..de56cc46c5c 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -108,6 +108,7 @@ FROM SymbolTable IMPORT NulSym,
ParametersDefinedInDefinition,
ParametersDefinedInImplementation,
ProcedureParametersDefined,
+ PutProcedureNoReturn,
CheckForUnImplementedExports,
CheckForUndeclaredExports,
IsHiddenTypeDeclared,
@@ -2098,6 +2099,17 @@ BEGIN
END BuildOptFunction ;
+(*
+ BuildNoReturnAttribute - provide an interface to the symbol table module.
+*)
+
+PROCEDURE BuildNoReturnAttribute (procedureSym: CARDINAL) ;
+BEGIN
+ Assert (IsProcedure (procedureSym)) ;
+ PutProcedureNoReturn (procedureSym, TRUE)
+END BuildNoReturnAttribute ;
+
+
(*
BuildPointerType - builds a pointer type.
The Stack:
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index ffc1a2c585f..c6c39d92962 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -191,6 +191,7 @@ EXPORT QUALIFIED NulSym,
PutProcedureEndQuad,
PutProcedureScopeQuad,
PutProcedureReachable,
+ PutProcedureNoReturn, IsProcedureNoReturn,
PutReadQuad, RemoveReadQuad,
PutWriteQuad, RemoveWriteQuad,
PutGnuAsm, PutGnuAsmOutput, PutGnuAsmInput, PutGnuAsmTrash,
@@ -1274,7 +1275,7 @@ PROCEDURE PutProcedureInline (Sym: CARDINAL) ;
(*
- IsProcedureBuiltin - returns TRUE if this procedure was declared as inlined.
+ IsProcedureInline - returns TRUE if this procedure was declared as inlined.
*)
PROCEDURE IsProcedureInline (Sym: CARDINAL) : BOOLEAN ;
@@ -1636,6 +1637,21 @@ PROCEDURE PutProcedureReachable (Sym: CARDINAL) ;
PROCEDURE IsProcedureReachable (Sym: CARDINAL) : BOOLEAN ;
+(*
+ PutProcedureNoReturn - places value into the no return attribute
+ field of procedure sym.
+*)
+
+PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsProcedureNoReturn - returns TRUE if this procedure never returns.
+*)
+
+PROCEDURE IsProcedureNoReturn (Sym: CARDINAL) : BOOLEAN ;
+
+
(*
PutModuleStartQuad - Places QuadNumber into the Module symbol, Sym.
QuadNumber is the start quad of Module,
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 01e431e269c..cc1a874b791 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -360,6 +360,7 @@ TYPE
IsBuiltin : BOOLEAN ; (* Was it declared __BUILTIN__ ? *)
BuiltinName : Name ; (* name of equivalent builtin *)
IsInline : BOOLEAN ; (* Was it declared __INLINE__ ? *)
+ IsNoReturn : BOOLEAN ; (* Attribute noreturn ? *)
ReturnOptional: BOOLEAN ; (* Is the return value optional? *)
IsExtern : BOOLEAN ; (* Make this procedure extern. *)
IsPublic : BOOLEAN ; (* Make this procedure visible. *)
@@ -3775,6 +3776,7 @@ BEGIN
IsBuiltin := FALSE ; (* Was it declared __BUILTIN__ ? *)
BuiltinName := NulName ; (* name of equivalent builtin *)
IsInline := FALSE ; (* Was is declared __INLINE__ ? *)
+ IsNoReturn := FALSE ; (* Declared attribute noreturn ? *)
ReturnOptional := FALSE ; (* Is the return value optional? *)
IsExtern := FALSE ; (* Make this procedure external. *)
IsPublic := FALSE ; (* Make this procedure visible. *)
@@ -3824,6 +3826,49 @@ BEGIN
END MakeProcedure ;
+(*
+ PutProcedureNoReturn - places value into the no return attribute
+ field of procedure sym.
+*)
+
+PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (Sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.IsNoReturn := value
+
+ ELSE
+ InternalError ('expecting ProcedureSym symbol')
+ END
+ END
+END PutProcedureNoReturn ;
+
+
+(*
+ IsProcedureNoReturn - returns TRUE if this procedure never returns.
+*)
+
+PROCEDURE IsProcedureNoReturn (Sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (Sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN Procedure.IsNoReturn
+
+ ELSE
+ InternalError ('expecting ProcedureSym symbol')
+ END
+ END
+END IsProcedureNoReturn ;
+
+
(*
PutMonoName - changes the IsMonoName boolean inside the procedure.
*)
diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
index fb4d7dcc4e6..ab409378673 100644
--- a/gcc/m2/gm2-gcc/m2decl.cc
+++ b/gcc/m2/gm2-gcc/m2decl.cc
@@ -211,7 +211,7 @@ tree
m2decl_BuildEndFunctionDeclaration (location_t location_begin,
location_t location_end, const char *name,
tree returntype, int isexternal,
- int isnested, int ispublic)
+ int isnested, int ispublic, int isnoreturn)
{
tree fntype;
tree fndecl;
@@ -244,6 +244,7 @@ m2decl_BuildEndFunctionDeclaration (location_t location_begin,
= build_decl (location_end, RESULT_DECL, NULL_TREE, returntype);
DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
TREE_TYPE (fndecl) = fntype;
+ TREE_THIS_VOLATILE (fndecl) = isnoreturn;
DECL_SOURCE_LOCATION (fndecl) = location_begin;
diff --git a/gcc/m2/gm2-gcc/m2decl.def b/gcc/m2/gm2-gcc/m2decl.def
index 036f903c002..6a1969336a2 100644
--- a/gcc/m2/gm2-gcc/m2decl.def
+++ b/gcc/m2/gm2-gcc/m2decl.def
@@ -149,7 +149,8 @@ PROCEDURE BuildStartFunctionDeclaration (uses_varargs: BOOLEAN) ;
PROCEDURE BuildEndFunctionDeclaration (location_begin, location_end: location_t;
name: ADDRESS; returntype: Tree;
- isexternal, isnested, ispublic: BOOLEAN) : Tree ;
+ isexternal, isnested, ispublic,
+ isnoreturn: BOOLEAN) : Tree ;
(*
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
index 13ecaafda2b..19dbb7be4e1 100644
--- a/gcc/m2/gm2-gcc/m2decl.h
+++ b/gcc/m2/gm2-gcc/m2decl.h
@@ -58,7 +58,8 @@ EXTERN void m2decl_RememberVariables (tree l);
EXTERN tree m2decl_BuildEndFunctionDeclaration (
location_t location_begin, location_t location_end, const char *name,
- tree returntype, int isexternal, int isnested, int ispublic);
+ tree returntype, int isexternal, int isnested, int ispublic,
+ int isnoreturn);
EXTERN void m2decl_BuildStartFunctionDeclaration (int uses_varargs);
EXTERN tree m2decl_BuildParameterDeclaration (location_t location, char *name,
tree type, int isreference);
diff --git a/gcc/m2/gm2-gcc/m2except.cc b/gcc/m2/gm2-gcc/m2except.cc
index 2f43b685b04..ab7df804558 100644
--- a/gcc/m2/gm2-gcc/m2except.cc
+++ b/gcc/m2/gm2-gcc/m2except.cc
@@ -103,18 +103,19 @@ m2except_InitExceptions (location_t location)
m2decl_BuildStartFunctionDeclaration (FALSE);
fn_rethrow_tree = m2decl_BuildEndFunctionDeclaration (
- location, location, "__cxa_rethrow", void_type_node, TRUE, FALSE, TRUE);
+ location, location, "__cxa_rethrow", void_type_node, TRUE, FALSE,
+ TRUE, FALSE);
TREE_NOTHROW (fn_rethrow_tree) = 0;
m2decl_BuildStartFunctionDeclaration (FALSE);
m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
fn_begin_catch_tree = m2decl_BuildEndFunctionDeclaration (
location, location, "__cxa_begin_catch", ptr_type_node, TRUE, FALSE,
- TRUE);
+ TRUE, FALSE);
m2decl_BuildStartFunctionDeclaration (FALSE);
fn_end_catch_tree = m2decl_BuildEndFunctionDeclaration (
location, location, "__cxa_end_catch", void_type_node, TRUE, FALSE,
- TRUE);
+ TRUE, FALSE);
/* This can throw if the destructor for the exception throws. */
TREE_NOTHROW (fn_end_catch_tree) = 0;
@@ -130,26 +131,28 @@ m2except_InitExceptions (location_t location)
m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
fn_throw_tree = m2decl_BuildEndFunctionDeclaration (
- location, location, "__cxa_throw", void_type_node, TRUE, FALSE, TRUE);
+ location, location, "__cxa_throw", void_type_node, TRUE, FALSE, TRUE,
+ FALSE);
/* Declare void __cxa_rethrow (void). */
m2decl_BuildStartFunctionDeclaration (FALSE);
fn_rethrow_tree = m2decl_BuildEndFunctionDeclaration (
- location, location, "__cxa_rethrow", void_type_node, TRUE, FALSE, TRUE);
+ location, location, "__cxa_rethrow", void_type_node, TRUE, FALSE, TRUE,
+ FALSE);
/* Declare void *__cxa_allocate_exception (size_t). */
m2decl_BuildStartFunctionDeclaration (FALSE);
m2decl_BuildParameterDeclaration (location, NULL, size_type_node, FALSE);
fn_allocate_exception_tree = m2decl_BuildEndFunctionDeclaration (
location, location, "__cxa_allocate_exception", ptr_type_node, TRUE,
- FALSE, TRUE);
+ FALSE, TRUE, FALSE);
/* Declare void *__cxa_free_exception (void *). */
m2decl_BuildStartFunctionDeclaration (FALSE);
m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
fn_free_exception_tree = m2decl_BuildEndFunctionDeclaration (
location, location, "__cxa_free_exception", ptr_type_node, TRUE, FALSE,
- TRUE);
+ TRUE, FALSE);
/* Define integer type exception type which will match C++ int type
in the C++ runtime library. */
diff --git a/gcc/testsuite/gm2/warnings/returntype/fail/badreturn.mod b/gcc/testsuite/gm2/warnings/returntype/fail/badreturn.mod
new file mode 100644
index 00000000000..af7fd81cba2
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/returntype/fail/badreturn.mod
@@ -0,0 +1,11 @@
+MODULE badreturn ;
+
+PROCEDURE X (VAR Y : BOOLEAN) : BOOLEAN;
+BEGIN
+ IF Y
+ THEN
+ RETURN FALSE
+ END
+END X ;
+
+END badreturn.
diff --git a/gcc/testsuite/gm2/warnings/returntype/fail/warnings-returntype-fail.exp b/gcc/testsuite/gm2/warnings/returntype/fail/warnings-returntype-fail.exp
new file mode 100644
index 00000000000..aaebe1f07dd
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/returntype/fail/warnings-returntype-fail.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/warnings/returntype/fail"
+
+global TORTURE_OPTIONS
+set TORTURE_OPTIONS { { -O0 -g -Werror=return-type } }
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/warnings/returntype/pass/Termbase.mod b/gcc/testsuite/gm2/warnings/returntype/pass/Termbase.mod
new file mode 100644
index 00000000000..0b47826321b
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/returntype/pass/Termbase.mod
@@ -0,0 +1,220 @@
+(* Termbase.mod provides GNU Modula-2 with a PIM 234 compatible Termbase.
+
+Copyright (C) 2004-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE Termbase ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2RTS IMPORT Halt ;
+IMPORT Display, Keyboard ;
+
+TYPE
+ ReadMethods = POINTER TO RECORD
+ r : ReadProcedure ;
+ s : StatusProcedure ;
+ next: ReadMethods ;
+ END ;
+
+ WriteMethod = POINTER TO RECORD
+ w : WriteProcedure ;
+ next: WriteMethod ;
+ END ;
+
+VAR
+ rStack: ReadMethods ;
+ wStack: WriteMethod ;
+
+
+(*
+ AssignRead - assigns a read procedure and status procedure for terminal
+ input. Done is set to TRUE if successful. Subsequent
+ Read and KeyPressed calls are mapped onto the user supplied
+ procedures. The previous read and status procedures are
+ uncovered and reused after UnAssignRead is called.
+*)
+
+PROCEDURE AssignRead (rp: ReadProcedure; sp: StatusProcedure;
+ VAR Done: BOOLEAN) ;
+VAR
+ t: ReadMethods ;
+BEGIN
+ t := rStack ;
+ NEW(rStack) ;
+ IF rStack=NIL
+ THEN
+ Done := FALSE
+ ELSE
+ WITH rStack^ DO
+ r := rp ;
+ s := sp ;
+ next := t
+ END ;
+ Done := TRUE
+ END
+END AssignRead ;
+
+
+(*
+ UnAssignRead - undo the last call to AssignRead and set Done to TRUE
+ on success.
+*)
+
+PROCEDURE UnAssignRead (VAR Done: BOOLEAN) ;
+VAR
+ t: ReadMethods ;
+BEGIN
+ IF rStack=NIL
+ THEN
+ Done := FALSE
+ ELSE
+ Done := TRUE
+ END ;
+ t := rStack ;
+ rStack := rStack^.next ;
+ DISPOSE(t)
+END UnAssignRead ;
+
+
+(*
+ Read - reads a single character using the currently active read
+ procedure.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+ IF rStack=NIL
+ THEN
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'no active read procedure')
+ ELSE
+ rStack^.r(ch)
+ END
+END Read ;
+
+
+(*
+ KeyPressed - returns TRUE if a character is available to be read.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+BEGIN
+ IF rStack=NIL
+ THEN
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'no active status procedure')
+ ELSE
+ RETURN( rStack^.s() )
+ END
+END KeyPressed ;
+
+
+(*
+ AssignWrite - assigns a write procedure for terminal output.
+ Done is set to TRUE if successful. Subsequent
+ Write calls are mapped onto the user supplied
+ procedure. The previous write procedure is
+ uncovered and reused after UnAssignWrite is called.
+*)
+
+PROCEDURE AssignWrite (wp: WriteProcedure; VAR Done: BOOLEAN) ;
+VAR
+ t: WriteMethod ;
+BEGIN
+ t := wStack ;
+ NEW(wStack) ;
+ IF wStack=NIL
+ THEN
+ Done := FALSE
+ ELSE
+ WITH wStack^ DO
+ w := wp ;
+ next := t
+ END ;
+ Done := TRUE
+ END
+END AssignWrite ;
+
+
+(*
+ UnAssignWrite - undo the last call to AssignWrite and set Done to TRUE
+ on success.
+*)
+
+PROCEDURE UnAssignWrite (VAR Done: BOOLEAN) ;
+VAR
+ t: WriteMethod ;
+BEGIN
+ IF wStack=NIL
+ THEN
+ Done := FALSE
+ ELSE
+ Done := TRUE
+ END ;
+ t := wStack ;
+ wStack := wStack^.next ;
+ DISPOSE(t)
+END UnAssignWrite ;
+
+
+(*
+ Write - writes a single character using the currently active write
+ procedure.
+*)
+
+PROCEDURE Write (VAR ch: CHAR) ;
+BEGIN
+ IF wStack=NIL
+ THEN
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'no active write procedure')
+ ELSE
+ wStack^.w(ch)
+ END
+END Write ;
+
+
+(*
+ Init -
+*)
+
+PROCEDURE Init ;
+VAR
+ Done: BOOLEAN ;
+BEGIN
+ rStack := NIL ;
+ wStack := NIL ;
+ AssignRead(Keyboard.Read, Keyboard.KeyPressed, Done) ;
+ IF NOT Done
+ THEN
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'failed to assign read routines from module Keyboard')
+ END ;
+ AssignWrite(Display.Write, Done) ;
+ IF NOT Done
+ THEN
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'failed to assign write routine from module Display')
+ END
+END Init ;
+
+
+BEGIN
+ Init
+END Termbase.
diff --git a/gcc/testsuite/gm2/warnings/returntype/pass/goodreturn.mod b/gcc/testsuite/gm2/warnings/returntype/pass/goodreturn.mod
new file mode 100644
index 00000000000..7b27949d403
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/returntype/pass/goodreturn.mod
@@ -0,0 +1,13 @@
+MODULE goodreturn ;
+
+PROCEDURE X (VAR Y : BOOLEAN) : BOOLEAN;
+BEGIN
+ IF Y
+ THEN
+ RETURN FALSE
+ ELSE
+ RETURN TRUE
+ END
+END X ;
+
+END goodreturn.
diff --git a/gcc/testsuite/gm2/warnings/returntype/pass/keypressedsimple.mod b/gcc/testsuite/gm2/warnings/returntype/pass/keypressedsimple.mod
new file mode 100644
index 00000000000..30d53477962
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/returntype/pass/keypressedsimple.mod
@@ -0,0 +1,21 @@
+MODULE keypressedsimple ;
+
+FROM M2RTS IMPORT Halt ;
+FROM Args IMPORT Narg ;
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+BEGIN
+ IF Narg () < 0
+ THEN
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'no active status procedure')
+ ELSE
+ RETURN FALSE
+ END
+END KeyPressed ;
+
+
+BEGIN
+ IF KeyPressed ()
+ THEN
+ END
+END keypressedsimple.
diff --git a/gcc/testsuite/gm2/warnings/returntype/pass/warnings-returntype-pass.exp b/gcc/testsuite/gm2/warnings/returntype/pass/warnings-returntype-pass.exp
new file mode 100644
index 00000000000..1cde1ae5440
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/returntype/pass/warnings-returntype-pass.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2003-2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaiusmod2@gmail.com)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/warnings/returntype/pass" -Werror=return-type
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture $testcase
+}
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-01-26 21:44 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-26 21:44 [gcc r13-5421] PR-108551 gcc/m2/gm2-libs-pim/Termbase.mod:128:1 error end of non-void Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).