diff options
author | Gaius Mulley <gaiusmod2@gmail.com> | 2023-03-23 16:37:11 +0000 |
---|---|---|
committer | Gaius Mulley <gaiusmod2@gmail.com> | 2023-03-23 16:37:11 +0000 |
commit | 5ededfa5b23781c3be6fcf6bb373418aa8bd6541 (patch) | |
tree | 4f1e0c0a7bbab2ca8a11f962148a9b45e5b1a193 | |
parent | 41ade3399bd1ec9927be1bb818965831232eda4b (diff) | |
download | gcc-5ededfa5b23781c3be6fcf6bb373418aa8bd6541.zip gcc-5ededfa5b23781c3be6fcf6bb373418aa8bd6541.tar.gz gcc-5ededfa5b23781c3be6fcf6bb373418aa8bd6541.tar.bz2 |
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>
17 files changed, 392 insertions, 80 deletions
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 4dffb63..a44c5c7 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 887dd02..59b1652 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 a9ec1e6..a13da82 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 c172039..ef8368a 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 64169c1..3701bcd 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 bcec299..767b617 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 0000000..8b7857e --- /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 0000000..315ff70 --- /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 0000000..940c988 --- /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 0000000..d79403e --- /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 0000000..bb9f19e --- /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 0000000..315ff70 --- /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 0000000..940c988 --- /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 0000000..0bc3016 --- /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 0000000..6b375c3 --- /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 0000000..cd2594f --- /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 0000000..d79403e --- /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 |