public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-6835] PR modula2/109264 Bugfix resolve opaque types containing sets
@ 2023-03-23 16:42 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-03-23 16:42 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:5ededfa5b23781c3be6fcf6bb373418aa8bd6541
commit r13-6835-g5ededfa5b23781c3be6fcf6bb373418aa8bd6541
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Thu Mar 23 16:37:11 2023 +0000
PR modula2/109264 Bugfix resolve opaque types containing sets
Resolve opaque type handling. The bug is caused by the compiler
attempting to resolve the meta types of a constant constructor.
It incorrectly attempts to get the type on an enumeration type
(resulting in NulSym) which causes the meta resolver to spin.
Some PHBuild rules (building records need to be copied from P3Build
so that hidden types are resolved in order across the compile.
gcc/m2/ChangeLog:
PR modula2/109264
* gm2-compiler/M2Quads.mod (BuildConstFunctionCall): Comment
out ErrorString in debugging block.
(BuildConstructorStart): Replace Assert with a call to
MetaErrorT3. Import MetaErrorT3.
* gm2-compiler/PCSymBuild.mod (buildConstFunction): Rename
local variables.
(WalkFunctionParam): Remove test for IsEnumeration when
resolving MIN or MAX parameters.
* gm2-compiler/PHBuild.bnf (BlockAssert): New procedure.
(ErrorArrayat): New procedure.
(Expect): Renamed parameter t to tok.
(PushQualident): New rule.
(ConstSetOrQualidentOrFunction): Force AutoOn.
(TypeDeclaration): Add debugging assert.
(SimpleType): Add debugging assert.
(DefaultRecordAttributes): New rule (and bugfix).
(FieldPragmaExpression): New rule (and bugfix).
(PragmaConstExpression): New rule (and bugfix).
(SetOrDesignatorOrFunction): Add debugging assert.
(Block): Add debugging assert.
* gm2-gcc/m2expr.cc (m2expr_ConstantExpressionWarning): int
to bool.
* gm2-gcc/m2expr.h (m2expr_TreeOverflow): int to bool.
(m2expr_GetBooleanTrue): Remove.
(m2expr_GetBooleanFalse): Remove.
* gm2-gcc/m2options.h (M2Options_SetStatistics): Replace
int with bool.
gcc/testsuite/ChangeLog:
PR modula2/109264
* gm2/iso/extended-opaque/pass/iso-extended-opaque-pass.exp:
New test.
* gm2/iso/extended-opaque/pass/stressset.def: New test.
* gm2/iso/extended-opaque/pass/stressset.mod: New test.
* gm2/iso/extended-opaque/pass/testset.mod: New test.
* gm2/projects/iso/small/run/pass/iso-extended-opaque-run-pass.exp:
New test.
* gm2/projects/iso/small/run/pass/stressset.def: New test.
* gm2/projects/iso/small/run/pass/stressset.mod: New test.
* gm2/projects/iso/small/run/pass/test1.mod: New test.
* gm2/projects/iso/small/run/pass/testlib.def: New test.
* gm2/projects/iso/small/run/pass/testlib.mod: New test.
* gm2/projects/iso/small/run/pass/testset.mod: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Quads.mod | 11 +-
gcc/m2/gm2-compiler/PCSymBuild.mod | 62 ++++---
gcc/m2/gm2-compiler/PHBuild.bnf | 202 ++++++++++++++++-----
gcc/m2/gm2-gcc/m2expr.cc | 2 +-
gcc/m2/gm2-gcc/m2expr.h | 7 +-
gcc/m2/gm2-gcc/m2options.h | 2 +-
.../pass/iso-extended-opaque-pass.exp | 36 ++++
.../gm2/iso/extended-opaque/pass/stressset.def | 6 +
.../gm2/iso/extended-opaque/pass/stressset.mod | 18 ++
.../gm2/iso/extended-opaque/pass/testset.mod | 8 +
.../run/pass/iso-extended-opaque-run-pass.exp | 40 ++++
.../gm2/projects/iso/small/run/pass/stressset.def | 6 +
.../gm2/projects/iso/small/run/pass/stressset.mod | 18 ++
.../gm2/projects/iso/small/run/pass/test1.mod | 9 +
.../gm2/projects/iso/small/run/pass/testlib.def | 16 ++
.../gm2/projects/iso/small/run/pass/testlib.mod | 21 +++
.../gm2/projects/iso/small/run/pass/testset.mod | 8 +
17 files changed, 392 insertions(+), 80 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 4dffb63dda7..a44c5c7e71b 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -34,7 +34,7 @@ FROM M2Scaffold IMPORT DeclareScaffold, mainFunction, initFunction,
FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaError3,
MetaErrors1, MetaErrors2, MetaErrors3,
MetaErrorT0, MetaErrorT1, MetaErrorT2,
- MetaErrorsT1, MetaErrorsT2,
+ MetaErrorsT1, MetaErrorsT2, MetaErrorT3,
MetaErrorStringT0, MetaErrorStringT1,
MetaErrorString1, MetaErrorString2,
MetaErrorN1, MetaErrorN2,
@@ -7492,7 +7492,7 @@ BEGIN
IF CompilerDebugging
THEN
printf2 ('procsym = %d token = %d\n', ProcSym, functok) ;
- ErrorStringAt (InitString ('constant function'), functok)
+ (* ErrorStringAt (InitString ('constant function'), functok) *)
END ;
PushT (NoOfParam) ;
IF (ProcSym # Convert) AND
@@ -12064,7 +12064,12 @@ VAR
BEGIN
PopT (type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
GetConstructorFromFifoQueue (constValue) ;
- Assert (type = GetSType (constValue)) ;
+ IF type # GetSType (constValue)
+ THEN
+ MetaErrorT3 (cbratokpos,
+ '{%E}the constructor type is {%1ad} and this is different from the constant {%2ad} which has a type {%2tad}',
+ type, constValue, constValue)
+ END ;
PushTtok (constValue, cbratokpos) ;
PushConstructor (type)
END BuildConstructorStart ;
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
index 887dd02400e..59b1652baab 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -1154,7 +1154,7 @@ PROCEDURE InitFunction (m: constType; p, t: CARDINAL; f, s: exprNode; more: BOOL
VAR
n: exprNode ;
BEGIN
- NEW(n) ;
+ NEW (n) ;
WITH n^ DO
tag := function ;
CASE tag OF
@@ -1170,7 +1170,7 @@ BEGIN
END
END ;
- PushAddress(exprStack, n)
+ PushAddress (exprStack, n)
END InitFunction ;
@@ -1342,21 +1342,21 @@ PROCEDURE TypeToMeta (type: CARDINAL) : constType ;
BEGIN
IF type=Char
THEN
- RETURN( char )
+ RETURN char
ELSIF type=Boolean
THEN
- RETURN( boolean )
- ELSIF IsRealType(type)
+ RETURN boolean
+ ELSIF IsRealType (type)
THEN
- RETURN( rtype )
- ELSIF IsComplexType(type)
+ RETURN rtype
+ ELSIF IsComplexType (type)
THEN
- RETURN( ctype )
- ELSIF IsOrdinalType(type)
+ RETURN ctype
+ ELSIF IsOrdinalType (type)
THEN
- RETURN( ztype )
+ RETURN ztype
ELSE
- RETURN( unknown )
+ RETURN unknown
END
END TypeToMeta ;
@@ -1371,33 +1371,35 @@ END TypeToMeta ;
PROCEDURE buildConstFunction (func: CARDINAL; n: CARDINAL) ;
VAR
- i : CARDINAL ;
- f, s: exprNode ;
+ i : CARDINAL ;
+ first,
+ second: exprNode ;
BEGIN
- f := NIL ;
- s := NIL ;
+ first := NIL ;
+ second := NIL ;
IF n=1
THEN
- f := PopAddress(exprStack)
+ first := PopAddress (exprStack)
ELSIF n>=2
THEN
i := n ;
WHILE i>2 DO
- s := PopAddress(exprStack) ;
- DISPOSE(s) ;
- DEC(i)
+ second := PopAddress (exprStack) ;
+ DISPOSE (second) ;
+ DEC (i)
END ;
- s := PopAddress(exprStack) ;
- f := PopAddress(exprStack)
+ second := PopAddress (exprStack) ;
+ first := PopAddress (exprStack)
END ;
IF func=Val
THEN
- InitConvert(cast, NulSym, f, s)
+ InitConvert (cast, NulSym, first, second)
ELSIF (func=Max) OR (func=Min)
THEN
- InitFunction(unknown, func, NulSym, f, s, FALSE)
+ InitFunction (unknown, func, NulSym, first, second, FALSE)
ELSE
- InitFunction(TypeToMeta(GetSkippedType(func)), func, GetSkippedType(func), f, s, n>2)
+ InitFunction (TypeToMeta(GetSkippedType(func)), func, GetSkippedType(func),
+ first, second, n>2)
END
END buildConstFunction ;
@@ -1788,7 +1790,7 @@ BEGIN
THEN
IF (func=Min) OR (func=Max)
THEN
- IF IsEnumeration(sym) OR IsSet(sym)
+ IF IsSet (sym)
THEN
type := SkipType(GetType(sym))
ELSE
@@ -1832,7 +1834,7 @@ BEGIN
type := getEtype(first) ;
RETURN( TRUE )
END ;
- RETURN( WalkFunctionParam(func, first) )
+ RETURN WalkFunctionParam (func, first)
ELSE
MetaError1('not expecting this function inside a constant expression {%1Dad}', func)
END
@@ -2059,9 +2061,13 @@ PROCEDURE WalkDes (d: exprNode) : BOOLEAN ;
BEGIN
IF d=NIL
THEN
- RETURN( FALSE )
+ RETURN FALSE
ELSE
- RETURN( doWalkDes(d) )
+ IF Debugging
+ THEN
+ DebugDes (d)
+ END ;
+ RETURN doWalkDes (d)
END
END WalkDes ;
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index a9ec1e6820f..a13da828c94 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -44,7 +44,9 @@ see <https://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE PHBuild ;
-FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
+ InsertTokenAndRewind, GetTokenNo, MakeVirtualTok ;
+
FROM M2Error IMPORT ErrorStringAt ;
FROM NameKey IMPORT NulName, Name, makekey ;
FROM M2Reserved IMPORT NulTok, ByTok, PeriodPeriodTok, tokToTok, toktype ;
@@ -55,6 +57,7 @@ FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
+ PushTFntok, Top,
StartBuildDefFile, StartBuildModFile,
BuildModuleStart,
EndBuildFile,
@@ -98,7 +101,8 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
BeginVarient, EndVarient, ElseVarient,
BeginVarientList, EndVarientList,
AddVarientRange, AddVarientEquality,
- CheckWithReference,
+ BuildDefaultFieldAlignment, BuildPragmaField,
+ CheckWithReference, DisplayStack, Annotate,
IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
FROM P3SymBuild IMPORT P3StartBuildProgModule,
@@ -120,6 +124,8 @@ FROM P3SymBuild IMPORT P3StartBuildProgModule,
BuildSubrange,
BuildNulName ;
+FROM P3SymBuild IMPORT CheckCanBeImported ;
+
FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
MakeRegInterface,
@@ -129,7 +135,7 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
StartScope, EndScope,
PutIncluded,
IsVarParam, IsProcedure, IsDefImp, IsModule,
- IsRecord,
+ IsRecord, IsProcType,
RequestSym,
GetSym, GetLocalSym ;
@@ -140,21 +146,34 @@ FROM M2CaseList IMPORT BeginCaseList, EndCaseList, ElseCase ;
FROM M2Reserved IMPORT NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
EqualTok, HashTok, LessGreaterTok, LessTok, LessEqualTok,
GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
- OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok, AndTok, AmbersandTok ;
+ OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok, AndTok,
+ AmbersandTok ;
IMPORT M2Error ;
CONST
Debugging = FALSE ;
- Pass1 = FALSE ; (* permanently disabled for the time being *)
- Pass2 = FALSE ; (* permanently disabled for the time being *)
- Pass3 = FALSE ;
VAR
WasNoError: BOOLEAN ;
+(*
+ BlockAssert - used when developing, if disabled the bug (incorrect stack level)
+ will be caught by the block and a user error issued.
+ This procedure useful to detect the failure earlier.
+*)
+
+PROCEDURE BlockAssert (value: BOOLEAN) ;
+BEGIN
+ IF Debugging
+ THEN
+ Assert (value)
+ END
+END BlockAssert ;
+
+
PROCEDURE ErrorString (s: String) ;
BEGIN
ErrorStringAt(s, GetTokenNo()) ;
@@ -168,6 +187,11 @@ BEGIN
END ErrorArray ;
+PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ;
+BEGIN
+ ErrorStringAt (InitString(a), tok)
+END ErrorArrayAt ;
+
% declaration PHBuild begin
@@ -315,7 +339,8 @@ BEGIN
(NOT InStopSet(identtok, stopset0, stopset1, stopset2))
THEN
(* SyntaxCheck would fail since currentoken is not part of the stopset
- we check to see whether any of currenttoken might be a commonly omitted token *)
+ we check to see whether any of currenttoken might be a commonly
+ omitted token. *)
IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR
CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
@@ -334,19 +359,16 @@ END PeepToken ;
Expect -
*)
-PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+PROCEDURE Expect (tok: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1;
+ stopset2: SetOfStop2) ;
BEGIN
- IF currenttoken=t
+ IF currenttoken=tok
THEN
- GetToken ;
- IF Pass1
- THEN
- PeepToken(stopset0, stopset1, stopset2)
- END
+ GetToken
ELSE
- MissingToken(t)
+ MissingToken (tok)
END ;
- SyntaxCheck(stopset0, stopset1, stopset2)
+ SyntaxCheck (stopset0, stopset1, stopset2)
END Expect ;
@@ -358,8 +380,8 @@ END Expect ;
PROCEDURE CompilationUnit () : BOOLEAN ;
BEGIN
WasNoError := TRUE ;
- FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
- RETURN( WasNoError )
+ FileUnit (SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+ RETURN WasNoError
END CompilationUnit ;
@@ -369,11 +391,11 @@ END CompilationUnit ;
PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
- IF IsAutoPushOn()
+ IF IsAutoPushOn ()
THEN
- PushTF(makekey(currentstring), identtok)
+ PushTF (makekey (currentstring), identtok)
END ;
- Expect(identtok, stopset0, stopset1, stopset2)
+ Expect (identtok, stopset0, stopset1, stopset2)
END Ident ;
@@ -592,6 +614,7 @@ ImplementationOrProgramModule := % Pus
Number := Integer | Real =:
+
Qualident := % VAR name: Name ;
Type, Sym, tok: CARDINAL ; %
Ident
@@ -616,6 +639,71 @@ Qualident := % VAR
{ "." Ident } % END %
=:
+PushQualident := % VAR name : Name ;
+ init, ip1 : CARDINAL ;
+ tok, tokstart: CARDINAL ; %
+ % PushAutoOn %
+ Ident % IF IsAutoPushOn()
+ THEN
+ PopTtok (name, tokstart) ;
+ tok := tokstart ;
+ init := GetSym (name) ;
+ IF init=NulSym
+ THEN
+ PushTFntok (NulSym, NulSym, name, tok)
+ ELSE
+ WHILE IsDefImp (init) OR IsModule (init) DO
+ IF currenttoken # periodtok
+ THEN
+ ErrorArrayAt ("expecting '.' after module in the construction of a qualident", tok) ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTtok (init, tok) ;
+ PopAuto ;
+ RETURN
+ ELSE
+ Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+ StartScope (init) ;
+ Ident (stopset0, stopset1, stopset2) ;
+ PopTtok (name, tok) ;
+ ip1 := GetSym (name) ;
+ IF ip1 = NulSym
+ THEN
+ ErrorArrayAt ("unknown ident in the construction of a qualident", tok) ;
+ EndScope ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTFntok (NulSym, NulSym, name, tok) ;
+ PopAuto ;
+ RETURN
+ ELSE
+ PutIncluded (ip1)
+ END ;
+ EndScope ;
+ CheckCanBeImported (init, ip1) ;
+ init := ip1
+ END
+ END ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ IF IsProcedure (init) OR IsProcType (init)
+ THEN
+ PushTtok (init, tok)
+ ELSE
+ PushTFtok (init, GetType(init), tok)
+ END
+ END
+ ELSE %
+ { "." Ident } % END %
+ % PopAuto %
+ =:
+
ConstantDeclaration := % PushAutoOn %
% VAR tokno: CARDINAL ; %
( Ident "=" % tokno := GetTokenNo () %
@@ -709,11 +797,16 @@ Constructor := '{' % Bui
[ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
'}' =:
-ConstSetOrQualidentOrFunction := Qualident
- [ Constructor | ConstActualParameters % BuildConstFunctionCall %
- ]
- | % BuildTypeForConstructor %
- Constructor =:
+ConstSetOrQualidentOrFunction := % PushAutoOn %
+ (
+ Qualident
+ [ Constructor |
+ ConstActualParameters % BuildConstFunctionCall %
+ ]
+ | % BuildTypeForConstructor %
+ Constructor
+ ) % PopAuto %
+ =:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
@@ -730,7 +823,10 @@ ByteAlignment := '<*' % Pus
Alignment := [ ByteAlignment ] =:
-TypeDeclaration := Ident "=" Type Alignment
+TypeDeclaration := % VAR top: CARDINAL ; %
+ % top := Top () %
+ Ident "=" Type Alignment
+ % BlockAssert (top = Top ()) %
=:
Type :=
@@ -742,7 +838,11 @@ Type :=
| ProcedureType ) % PopAuto %
=:
-SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+SimpleType := % VAR top: CARDINAL ; %
+ % top := Top () %
+ ( Qualident [ SubrangeType ] | Enumeration | SubrangeType )
+ % BlockAssert (top = Top ()) %
+ =:
Enumeration := "("
( IdentList
@@ -782,18 +882,24 @@ ArrayType := "ARRAY"
RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
-DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+DefaultRecordAttributes := '<*' % PushAutoOn %
+ AttributeExpression % BuildDefaultFieldAlignment %
+ % PopAuto %
+ '*>' =:
RecordFieldPragma := [ '<*' FieldPragmaExpression
- { ',' FieldPragmaExpression } '*>' ] =:
+ { ',' FieldPragmaExpression } '*>' ] =:
-FieldPragmaExpression := % PushAutoOff %
- Ident [ '(' ConstExpression ')' ] % PopAuto %
+FieldPragmaExpression := % PushAutoOn %
+ Ident PragmaConstExpression % BuildPragmaField %
+ % PopAuto %
=:
-AttributeExpression := % PushAutoOff %
- Ident '(' ConstExpression ')' % PopAuto %
- =:
+PragmaConstExpression := ( '(' ConstExpression ')' | % PushT(NulSym) %
+ % Annotate('NulSym||no pragma const') %
+ ) =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
@@ -1002,12 +1108,21 @@ Term := Factor { SilentMulOperator Factor
Factor := Number | string | SetOrDesignatorOrFunction |
"(" Expression ")" | "NOT" Factor | ConstAttribute =:
--- again Set | Designator causes problems as both has a first symbol, ident or Qualident
+-- again Set | Designator causes problems as both have a first symbol, ident or Qualident
+
+ParseConstructor := "{" [ SilentElement { "," SilentElement } ] "}" =:
+
-SetOrDesignatorOrFunction := ( Qualident [ Constructor |
- SimpleDes [ ActualParameters ]
- ] | Constructor
+SetOrDesignatorOrFunction := % VAR n: CARDINAL ; %
+ % n := Top () %
+ % Assert (NOT IsAutoPushOn ()) %
+ ( Qualident [ ParseConstructor
+ |
+ SilentSimpleDes [ SilentActualParameters ]
+ ] |
+ ParseConstructor
)
+ % Assert (n = Top ()) %
=:
-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
@@ -1147,7 +1262,12 @@ AttributeUnused := [ "<*" Ident "*>" ] =:
ProcedureBlock := { Declaration } [ "BEGIN" BlockBody ] "END"
=:
-Block := { Declaration } InitialBlock FinalBlock "END" =:
+Block := % VAR top: CARDINAL ; %
+ % top := Top () %
+ { Declaration } % BlockAssert (top = Top ()) %
+ InitialBlock % BlockAssert (top = Top ()) %
+ FinalBlock % BlockAssert (top = Top ()) %
+ "END" =:
InitialBlock := [ "BEGIN" BlockBody ] =:
diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
index c172039e940..ef8368af2a4 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -939,7 +939,7 @@ m2expr_ConstantExpressionWarning (tree value)
an overflow. No error message or warning is emitted and no
modification is made to, t. */
-int
+bool
m2expr_TreeOverflow (tree t)
{
if ((TREE_CODE (t) == INTEGER_CST
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
index 64169c163c6..3701bcd2772 100644
--- a/gcc/m2/gm2-gcc/m2expr.h
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -120,7 +120,7 @@ EXTERN tree m2expr_BuildTrunc (tree op1);
EXTERN tree m2expr_BuildCoerce (location_t location, tree des, tree type,
tree expr);
EXTERN tree m2expr_RemoveOverflow (tree t);
-EXTERN int m2expr_TreeOverflow (tree t);
+EXTERN bool m2expr_TreeOverflow (tree t);
EXTERN unsigned int m2expr_StringLength (tree string);
EXTERN tree m2expr_FoldAndStrip (tree t);
@@ -220,11 +220,6 @@ EXTERN tree m2expr_GetWordOne (location_t location);
EXTERN tree m2expr_GetPointerZero (location_t location);
EXTERN tree m2expr_GetPointerOne (location_t location);
-#if 0
-EXTERN tree m2expr_GetBooleanTrue (void);
-EXTERN tree m2expr_GetBooleanFalse (void);
-#endif
-
EXTERN int m2expr_CompareTrees (tree e1, tree e2);
EXTERN tree m2expr_build_unary_op (location_t location ATTRIBUTE_UNUSED,
enum tree_code code, tree arg,
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index bcec299cffe..767b617282a 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -96,7 +96,7 @@ EXTERN bool M2Options_SetCpp (bool value);
EXTERN void M2Options_SetSwig (bool value);
EXTERN void M2Options_SetForcedLocation (location_t location);
EXTERN location_t M2Options_OverrideLocation (location_t location);
-EXTERN void M2Options_SetStatistics (int on);
+EXTERN void M2Options_SetStatistics (bool on);
EXTERN void M2Options_CppProg (const char *program);
EXTERN void M2Options_CppArg (const char *opt, const char *arg, bool joined);
EXTERN void M2Options_SetWholeProgram (bool value);
diff --git a/gcc/testsuite/gm2/iso/extended-opaque/pass/iso-extended-opaque-pass.exp b/gcc/testsuite/gm2/iso/extended-opaque/pass/iso-extended-opaque-pass.exp
new file mode 100755
index 00000000000..8b7857e181d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/extended-opaque/pass/iso-extended-opaque-pass.exp
@@ -0,0 +1,36 @@
+# 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_iso "${srcdir}/gm2/iso/extended-opaque/pass" -fextended-opaque
+
+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
+}
diff --git a/gcc/testsuite/gm2/iso/extended-opaque/pass/stressset.def b/gcc/testsuite/gm2/iso/extended-opaque/pass/stressset.def
new file mode 100644
index 00000000000..315ff70040c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/extended-opaque/pass/stressset.def
@@ -0,0 +1,6 @@
+DEFINITION MODULE stressset ;
+
+TYPE
+ dataType ;
+
+END stressset.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/extended-opaque/pass/stressset.mod b/gcc/testsuite/gm2/iso/extended-opaque/pass/stressset.mod
new file mode 100644
index 00000000000..940c9882c0d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/extended-opaque/pass/stressset.mod
@@ -0,0 +1,18 @@
+IMPLEMENTATION MODULE stressset ;
+
+TYPE
+ enum = (red, blue, green) ;
+
+CONST
+ (* max = ORD (MAX (enum)) + 1 ; *)
+ max = MAX (enum) + 1 ;
+
+
+TYPE
+ dataType = POINTER TO RECORD
+ next : dataType ;
+ contents: ARRAY [0..max] OF CARDINAL ;
+ set : SET OF enum ;
+ END ;
+
+END stressset.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/extended-opaque/pass/testset.mod b/gcc/testsuite/gm2/iso/extended-opaque/pass/testset.mod
new file mode 100644
index 00000000000..d79403ed481
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/extended-opaque/pass/testset.mod
@@ -0,0 +1,8 @@
+MODULE testset ;
+
+FROM stressset IMPORT dataType ;
+
+VAR
+ data: dataType ;
+BEGIN
+END testset.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/iso-extended-opaque-run-pass.exp b/gcc/testsuite/gm2/projects/iso/small/run/pass/iso-extended-opaque-run-pass.exp
new file mode 100755
index 00000000000..bb9f19ef217
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/iso-extended-opaque-run-pass.exp
@@ -0,0 +1,40 @@
+# Copyright (C) 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_iso "${srcdir}/gm2/projects/iso/small/run/pass"
+gm2_link_obj testlib.o
+
+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
+ }
+
+ if { $testcase != "$srcdir/$subdir/testlib.mod" } {
+ gm2_target_compile $srcdir/$subdir/testlib.mod testlib.o object "-g"
+ gm2-torture-execute $testcase "" "pass"
+ }
+}
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/stressset.def b/gcc/testsuite/gm2/projects/iso/small/run/pass/stressset.def
new file mode 100644
index 00000000000..315ff70040c
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/stressset.def
@@ -0,0 +1,6 @@
+DEFINITION MODULE stressset ;
+
+TYPE
+ dataType ;
+
+END stressset.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/stressset.mod b/gcc/testsuite/gm2/projects/iso/small/run/pass/stressset.mod
new file mode 100644
index 00000000000..940c9882c0d
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/stressset.mod
@@ -0,0 +1,18 @@
+IMPLEMENTATION MODULE stressset ;
+
+TYPE
+ enum = (red, blue, green) ;
+
+CONST
+ (* max = ORD (MAX (enum)) + 1 ; *)
+ max = MAX (enum) + 1 ;
+
+
+TYPE
+ dataType = POINTER TO RECORD
+ next : dataType ;
+ contents: ARRAY [0..max] OF CARDINAL ;
+ set : SET OF enum ;
+ END ;
+
+END stressset.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/test1.mod b/gcc/testsuite/gm2/projects/iso/small/run/pass/test1.mod
new file mode 100644
index 00000000000..0bc30166113
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/test1.mod
@@ -0,0 +1,9 @@
+MODULE test1 ;
+
+FROM testlib IMPORT opaque ;
+
+VAR
+ ptr: opaque ;
+BEGIN
+
+END test1.
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/testlib.def b/gcc/testsuite/gm2/projects/iso/small/run/pass/testlib.def
new file mode 100644
index 00000000000..6b375c372d4
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/testlib.def
@@ -0,0 +1,16 @@
+DEFINITION MODULE testlib ;
+
+(*
+ Title : testlib
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Tue Mar 21 13:43:56 2023
+ Revision : $Version$
+ Description:
+*)
+
+TYPE
+ opaque ;
+
+
+END testlib.
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/testlib.mod b/gcc/testsuite/gm2/projects/iso/small/run/pass/testlib.mod
new file mode 100644
index 00000000000..cd2594f5a80
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/testlib.mod
@@ -0,0 +1,21 @@
+IMPLEMENTATION MODULE testlib ;
+
+
+CONST
+ Red = cons {2, NIL, arrayT {1, 2, 3}} ;
+
+TYPE
+ cons = RECORD
+ high: CARDINAL ;
+ ptr : opaque ;
+ content: arrayT ;
+ END ;
+
+ arrayT = ARRAY [MIN(enum)..MAX(enum)] OF CARDINAL ;
+
+ enum = (red, blue, green) ;
+
+ opaque = POINTER TO CHAR ;
+
+
+END testlib.
diff --git a/gcc/testsuite/gm2/projects/iso/small/run/pass/testset.mod b/gcc/testsuite/gm2/projects/iso/small/run/pass/testset.mod
new file mode 100644
index 00000000000..d79403ed481
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/small/run/pass/testset.mod
@@ -0,0 +1,8 @@
+MODULE testset ;
+
+FROM stressset IMPORT dataType ;
+
+VAR
+ data: dataType ;
+BEGIN
+END testset.
\ No newline at end of file
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-03-23 16:42 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-03-23 16:42 [gcc r13-6835] PR modula2/109264 Bugfix resolve opaque types containing sets 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).