diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod index 9e58ef05d36cc81832c206c442c044ede7f97d2e..d2bb4ab7da355abb77cd1b57e1757404b265dd86 100644 --- a/gcc/m2/gm2-compiler/M2Check.mod +++ b/gcc/m2/gm2-compiler/M2Check.mod @@ -36,7 +36,7 @@ FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ; FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType, Char ; FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex, ForeachIndiceInIndexDo ; FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ; -FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ; +FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4, MetaError1 ; FROM StrLib IMPORT StrEqual ; FROM M2Debug IMPORT Assert ; @@ -504,10 +504,8 @@ BEGIN (* and also generate a sub error containing detail. *) IF (left # tinfo^.left) OR (right # tinfo^.right) THEN - tinfo^.error := ChainError (tinfo^.token, tinfo^.error) ; - s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters"), - left, right) ; - ErrorString (tinfo^.error, s) + MetaError1 ('formal parameter {%1EDad}', right) ; + MetaError1 ('actual parameter {%1EDad}', left) END END END buildError4 ; diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf index f1eafc83da7c10a6d28690c993bc78f0d7ac3875..b9a6daa70b2e47a76a71691eb6663ac8d464996f 100644 --- a/gcc/m2/gm2-compiler/P2Build.bnf +++ b/gcc/m2/gm2-compiler/P2Build.bnf @@ -45,7 +45,9 @@ see <https://www.gnu.org/licenses/>. *) IMPLEMENTATION MODULE P2Build ; -FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ; +FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, + InsertTokenAndRewind, GetTokenNo, MakeVirtual2Tok ; + FROM M2MetaError IMPORT MetaErrorStringT0, MetaErrorT1 ; FROM NameKey IMPORT NulName, Name, makekey, MakeKey ; FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok ; @@ -765,12 +767,17 @@ IdentList := Ident % VAR END % =: -SubrangeType := "[" ConstExpression ".." ConstExpression "]" % BuildSubrange(NulSym) % +SubrangeType := % VAR start, combined: CARDINAL ; % + % start := GetTokenNo () % + "[" ConstExpression ".." ConstExpression "]" % combined := MakeVirtual2Tok (start, GetTokenNo ()-1) % + % BuildSubrange (combined, NulSym) % =: -PrefixedSubrangeType := "[" ConstExpression ".." ConstExpression "]" % VAR t: CARDINAL ; % - % PopT(t) ; - BuildSubrange(t) % +PrefixedSubrangeType := % VAR qual, start, combined: CARDINAL ; % + % PopTtok (qual, start) % + "[" ConstExpression ".." ConstExpression "]" + % combined := MakeVirtual2Tok (start, GetTokenNo ()-1) % + % BuildSubrange (combined, qual) % =: ArrayType := "ARRAY" % VAR arrayType, tok: CARDINAL ; % diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def b/gcc/m2/gm2-compiler/P2SymBuild.def index b570286d03b34b3ce33513160dba855150362965..eab8c42d92184c9f783ec24316bac0d53f30d840 100644 --- a/gcc/m2/gm2-compiler/P2SymBuild.def +++ b/gcc/m2/gm2-compiler/P2SymBuild.def @@ -432,7 +432,7 @@ PROCEDURE StartBuildEnumeration ; |------------| |------------| *) -PROCEDURE BuildSubrange (Base: CARDINAL) ; +PROCEDURE BuildSubrange (tok: CARDINAL; Base: CARDINAL) ; (* diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod index a625e7dd95d75d1d89b9e54b7adb8d6d87810d37..1b59f3d631b6fae109e4ecc39e306899ce50febb 100644 --- a/gcc/m2/gm2-compiler/P2SymBuild.mod +++ b/gcc/m2/gm2-compiler/P2SymBuild.mod @@ -907,14 +907,13 @@ END StartBuildEnumeration ; |------------| |------------| *) -PROCEDURE BuildSubrange (Base: CARDINAL) ; +PROCEDURE BuildSubrange (tok: CARDINAL; Base: CARDINAL) ; VAR name: Name ; Type: CARDINAL ; - tok : CARDINAL ; BEGIN - PopTtok(name, tok) ; - Type := MakeSubrange(tok, name) ; + PopT (name) ; + Type := MakeSubrange (tok, name) ; PutSubrangeIntoFifoQueue(Type) ; (* Store Subrange away so that we can fill in *) (* its bounds during pass 3. *) PutSubrangeIntoFifoQueue(Base) ; (* store Base type of subrange away as well. *) diff --git a/gcc/testsuite/gm2/pim/fail/badbecomes2.mod b/gcc/testsuite/gm2/pim/fail/badbecomes2.mod new file mode 100644 index 0000000000000000000000000000000000000000..323043981d519e6323b64f81f4fd0ab1dd39bf69 --- /dev/null +++ b/gcc/testsuite/gm2/pim/fail/badbecomes2.mod @@ -0,0 +1,9 @@ +MODULE badbecomes2 ; + +TYPE + enums = (red, blue, green) ; +VAR + setvar: SET OF enums ; +BEGIN + setvar := green ; (* Should detect an error here. *) +END badbecomes2. diff --git a/gcc/testsuite/gm2/pim/fail/badparamset1.mod b/gcc/testsuite/gm2/pim/fail/badparamset1.mod new file mode 100644 index 0000000000000000000000000000000000000000..35d4f488f466f7b87ca25b5fccbf159f99f02168 --- /dev/null +++ b/gcc/testsuite/gm2/pim/fail/badparamset1.mod @@ -0,0 +1,16 @@ +MODULE badparamset1 ; + +TYPE + month = SET OF [1..12] ; + day = SET OF [1..31] ; + + +PROCEDURE foo (d: day) ; +BEGIN +END foo ; + +VAR + m: month ; +BEGIN + foo (m) +END badparamset1. diff --git a/gcc/testsuite/gm2/pim/fail/badparamset2.mod b/gcc/testsuite/gm2/pim/fail/badparamset2.mod new file mode 100644 index 0000000000000000000000000000000000000000..bddc745f244b2f46455196dc85b87feb99837ed9 --- /dev/null +++ b/gcc/testsuite/gm2/pim/fail/badparamset2.mod @@ -0,0 +1,16 @@ +MODULE badparamset2 ; + +TYPE + month = SET OF [1..12] ; + day = SET OF [1..31] ; + + +PROCEDURE foo (d: day) ; +BEGIN +END foo ; + +VAR + m: month ; +BEGIN + foo (m) +END badparamset2. diff --git a/gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod b/gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod new file mode 100644 index 0000000000000000000000000000000000000000..0bf498ce6f0d2fa27516379c88e3cd211fa06203 --- /dev/null +++ b/gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod @@ -0,0 +1,8 @@ +MODULE badsyntaxset1 ; + +TYPE + foo = SET OF [cat..dog] ; + +BEGIN + +END badsyntaxset1.