aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/m2/gm2-compiler/M2Check.mod111
-rw-r--r--gcc/m2/gm2-compiler/M2GenGCC.mod212
-rw-r--r--gcc/m2/gm2-compiler/M2Quads.mod2
-rw-r--r--gcc/testsuite/gm2/cse/pass/testcse54.mod7
-rw-r--r--gcc/testsuite/gm2/iso/run/pass/array9.mod28
-rw-r--r--gcc/testsuite/gm2/iso/run/pass/strcons3.mod30
-rw-r--r--gcc/testsuite/gm2/iso/run/pass/strcons4.mod36
-rw-r--r--gcc/testsuite/gm2/pim/fail/badset1.mod13
-rw-r--r--gcc/testsuite/gm2/pim/fail/badset2.mod13
-rw-r--r--gcc/testsuite/gm2/pim/fail/badset3.mod11
-rw-r--r--gcc/testsuite/gm2/pim/fail/badset4.mod11
11 files changed, 383 insertions, 91 deletions
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 5b45ad3..20d463d 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -46,7 +46,8 @@ FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst,
IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
- IsParameter, IsConstString, IsConstLitInternal, IsConstLit ;
+ IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
+ GetStringLength ;
FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
FROM M2System IMPORT Address ;
@@ -258,7 +259,35 @@ END checkSubrange ;
(*
- checkArrayTypeEquivalence -
+ checkUnbounded - check to see if the unbounded is type compatible with right.
+ This is only allowed during parameter passing.
+*)
+
+PROCEDURE checkUnbounded (result: status; tinfo: tInfo; unbounded, right: CARDINAL) : status ;
+VAR
+ lLow, rLow,
+ lHigh, rHigh: CARDINAL ;
+BEGIN
+ (* Firstly check to see if we have resolved this as false. *)
+ IF isFalse (result)
+ THEN
+ RETURN result
+ ELSE
+ Assert (IsUnbounded (unbounded)) ;
+ IF tinfo^.kind = parameter
+ THEN
+ (* --fixme-- we should check the unbounded data type against the type of right. *)
+ RETURN true
+ ELSE
+ (* Not allowed to use an unbounded symbol (type) in an expression or assignment. *)
+ RETURN false
+ END
+ END
+END checkUnbounded ;
+
+
+(*
+ checkArrayTypeEquivalence - check array and unbounded array type equivalence.
*)
PROCEDURE checkArrayTypeEquivalence (result: status; tinfo: tInfo;
@@ -273,7 +302,7 @@ BEGIN
THEN
lSub := GetArraySubscript (left) ;
rSub := GetArraySubscript (right) ;
- result := checkPair (result, tinfo, GetType (left), GetType (right)) ;
+ result := checkPair (result, tinfo, GetSType (left), GetSType (right)) ;
IF (lSub # NulSym) AND (rSub # NulSym)
THEN
result := checkSubrange (result, tinfo, getSType (lSub), getSType (rSub))
@@ -284,8 +313,22 @@ BEGIN
THEN
RETURN true
ELSE
- result := checkPair (result, tinfo, GetType (left), GetType (right))
+ result := checkUnbounded (result, tinfo, left, right)
END
+ ELSIF IsUnbounded (right) AND (IsArray (left) OR IsUnbounded (left))
+ THEN
+ IF IsGenericSystemType (getSType (right)) OR IsGenericSystemType (getSType (left))
+ THEN
+ RETURN true
+ ELSE
+ result := checkUnbounded (result, tinfo, right, left)
+ END
+ ELSIF IsArray (left) AND IsConst (right)
+ THEN
+ result := checkPair (result, tinfo, GetType (left), GetType (right))
+ ELSIF IsArray (right) AND IsConst (left)
+ THEN
+ result := checkPair (result, tinfo, GetType (left), GetType (right))
END ;
RETURN result
END checkArrayTypeEquivalence ;
@@ -547,12 +590,12 @@ END checkBaseTypeEquivalence ;
(*
- IsTyped -
+ IsTyped - returns TRUE if sym will have a type.
*)
PROCEDURE IsTyped (sym: CARDINAL) : BOOLEAN ;
BEGIN
- RETURN IsVar (sym) OR IsVar (sym) OR IsParameter (sym) OR
+ RETURN IsVar (sym) OR IsParameter (sym) OR IsConstructor (sym) OR
(IsConst (sym) AND IsConstructor (sym)) OR IsParameter (sym) OR
(IsConst (sym) AND (GetType (sym) # NulSym))
END IsTyped ;
@@ -630,16 +673,26 @@ BEGIN
RETURN result
ELSIF IsConstString (left)
THEN
- typeRight := GetDType (right) ;
- IF typeRight = NulSym
+ IF IsConstString (right)
THEN
- RETURN result
- ELSIF IsSet (typeRight) OR IsEnumeration (typeRight) OR IsProcedure (typeRight) OR
- IsRecord (typeRight)
+ RETURN true
+ ELSIF IsTyped (right)
THEN
- RETURN false
- ELSE
- RETURN doCheckPair (result, tinfo, Char, typeRight)
+ typeRight := GetDType (right) ;
+ IF typeRight = NulSym
+ THEN
+ RETURN result
+ ELSIF IsSet (typeRight) OR IsEnumeration (typeRight) OR
+ IsProcedure (typeRight) OR IsRecord (typeRight)
+ THEN
+ RETURN false
+ ELSIF IsArray (typeRight)
+ THEN
+ RETURN doCheckPair (result, tinfo, Char, GetType (typeRight))
+ ELSIF GetStringLength (tinfo^.token, left) = 1
+ THEN
+ RETURN doCheckPair (result, tinfo, Char, typeRight)
+ END
END
END ;
RETURN result
@@ -773,6 +826,30 @@ END checkSystemEquivalence ;
(*
+ checkTypeKindViolation - returns false if one operand left or right is
+ a set, record or array.
+*)
+
+PROCEDURE checkTypeKindViolation (result: status; tinfo: tInfo;
+ left, right: CARDINAL) : status ;
+BEGIN
+ IF isFalse (result) OR (result = visited)
+ THEN
+ RETURN result
+ ELSE
+ (* We have checked IsSet (left) and IsSet (right) etc in doCheckPair. *)
+ IF (IsSet (left) OR IsSet (right)) OR
+ (IsRecord (left) OR IsRecord (right)) OR
+ (IsArray (left) OR IsArray (right))
+ THEN
+ RETURN false
+ END
+ END ;
+ RETURN result
+END checkTypeKindViolation ;
+
+
+(*
doCheckPair -
*)
@@ -810,7 +887,11 @@ BEGIN
result := checkGenericTypeEquivalence (result, left, right) ;
IF NOT isKnown (result)
THEN
- result := checkTypeKindEquivalence (result, tinfo, left, right)
+ result := checkTypeKindEquivalence (result, tinfo, left, right) ;
+ IF NOT isKnown (result)
+ THEN
+ result := checkTypeKindViolation (result, tinfo, left, right)
+ END
END
END
END
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index aeba48d..7633b84 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -511,8 +511,8 @@ BEGIN
LogicalXorOp : CodeSetSymmetricDifference (q) |
LogicalDiffOp : CodeSetLogicalDifference (q) |
IfLessOp : CodeIfLess (q, op1, op2, op3) |
- IfEquOp : CodeIfEqu (q, op1, op2, op3) |
- IfNotEquOp : CodeIfNotEqu (q, op1, op2, op3) |
+ IfEquOp : CodeIfEqu (q) |
+ IfNotEquOp : CodeIfNotEqu (q) |
IfGreEquOp : CodeIfGreEqu (q, op1, op2, op3) |
IfLessEquOp : CodeIfLessEqu (q, op1, op2, op3) |
IfGreOp : CodeIfGre (q, op1, op2, op3) |
@@ -2489,17 +2489,8 @@ END FoldBuiltinFunction ;
(*
CodeParam - builds a parameter list.
-
- NOTE that we almost can treat VAR and NON VAR parameters the same, expect for
- some types:
-
- procedure parameters
- unbounded parameters
-
- these require special attention and thus it is easier to test individually
- for VAR and NON VAR parameters.
-
- NOTE that we CAN ignore ModeOfAddr though
+ Note that we can ignore ModeOfAddr as any lvalue will
+ have been created in a preceeding quadruple.
*)
PROCEDURE CodeParam (quad: CARDINAL) ;
@@ -7299,101 +7290,172 @@ END ComparisonMixTypes ;
(*
- CodeIfEqu - codes the quadruple if op1 = op2 then goto op3
+ PerformCodeIfEqu -
*)
-PROCEDURE CodeIfEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE PerformCodeIfEqu (quad: CARDINAL) ;
VAR
- tl, tr: Tree ;
- location : location_t ;
+ tl, tr : Tree ;
+ location : location_t ;
+ left, right, dest, combined,
+ leftpos, rightpos, destpos : CARDINAL ;
+ overflow : BOOLEAN ;
+ op : QuadOperator ;
BEGIN
- location := TokenToLocation(CurrentQuadToken) ;
-
- (* firstly ensure that any constant literal is declared *)
- DeclareConstant(CurrentQuadToken, op1) ;
- DeclareConstant(CurrentQuadToken, op2) ;
- DeclareConstructor(CurrentQuadToken, quad, op1) ;
- DeclareConstructor(CurrentQuadToken, quad, op2) ;
- IF IsConst(op1) AND IsConst(op2)
+ (* Ensure that any remaining undeclared constant literal is declared. *)
+ GetQuadOtok (quad, combined, op,
+ left, right, dest, overflow,
+ leftpos, rightpos, destpos) ;
+ location := TokenToLocation (combined) ;
+ IF IsConst (left) AND IsConst (right)
THEN
- PushValue(op1) ;
- PushValue(op2) ;
- IF Equ(CurrentQuadToken)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF Equ (combined)
THEN
- BuildGoto(location, string(CreateLabelName(op3)))
+ BuildGoto (location, string (CreateLabelName (dest)))
ELSE
- (* fall through *)
+ (* Fall through. *)
END
- ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
- IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+ ELSIF IsConstSet (left) OR (IsVar (left) AND IsSet (SkipType (GetType (left)))) OR
+ IsConstSet (right) OR (IsVar (right) AND IsSet (SkipType (GetType (right))))
THEN
- CodeIfSetEqu(quad, op1, op2, op3)
+ CodeIfSetEqu (quad, left, right, dest)
ELSE
- IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
+ IF IsComposite (GetType (left)) OR IsComposite (GetType (right))
THEN
- MetaErrorT2 (CurrentQuadToken,
+ MetaErrorT2 (combined,
'equality tests between composite types not allowed {%1Eatd} and {%2atd}',
- op1, op2)
+ left, right)
ELSE
- ConvertBinaryOperands(location,
- tl, tr,
- ComparisonMixTypes (SkipType (GetType (op1)),
- SkipType (GetType (op2)),
- CurrentQuadToken),
- op1, op2) ;
- DoJump(location, BuildEqualTo(location, tl, tr), NIL, string(CreateLabelName(op3)))
+ ConvertBinaryOperands (location,
+ tl, tr,
+ ComparisonMixTypes (SkipType (GetType (left)),
+ SkipType (GetType (right)),
+ combined),
+ left, right) ;
+ DoJump (location, BuildEqualTo (location, tl, tr), NIL,
+ string (CreateLabelName (dest)))
END
END
-END CodeIfEqu ;
+END PerformCodeIfEqu ;
(*
- CodeIfNotEqu - codes the quadruple if op1 # op2 then goto op3
+ PerformCodeIfNotEqu -
*)
-PROCEDURE CodeIfNotEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE PerformCodeIfNotEqu (quad: CARDINAL) ;
VAR
- tl, tr : Tree ;
- location: location_t ;
+ tl, tr : Tree ;
+ location : location_t ;
+ left, right, dest, combined,
+ leftpos, rightpos, destpos : CARDINAL ;
+ overflow : BOOLEAN ;
+ op : QuadOperator ;
BEGIN
- location := TokenToLocation(CurrentQuadToken) ;
-
- (* firstly ensure that any constant literal is declared *)
- DeclareConstant(CurrentQuadToken, op1) ;
- DeclareConstant(CurrentQuadToken, op2) ;
- DeclareConstructor(CurrentQuadToken, quad, op1) ;
- DeclareConstructor(CurrentQuadToken, quad, op2) ;
- IF IsConst(op1) AND IsConst(op2)
+ (* Ensure that any remaining undeclared constant literal is declared. *)
+ GetQuadOtok (quad, combined, op,
+ left, right, dest, overflow,
+ leftpos, rightpos, destpos) ;
+ location := TokenToLocation (combined) ;
+ IF IsConst (left) AND IsConst (right)
THEN
- PushValue(op1) ;
- PushValue(op2) ;
- IF NotEqu(CurrentQuadToken)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF NotEqu (combined)
THEN
- BuildGoto(location, string(CreateLabelName(op3)))
+ BuildGoto (location, string (CreateLabelName (dest)))
ELSE
- (* fall through *)
+ (* Fall through. *)
END
- ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
- IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+ ELSIF IsConstSet (left) OR (IsVar (left) AND IsSet (SkipType (GetType (left)))) OR
+ IsConstSet (right) OR (IsVar (right) AND IsSet (SkipType (GetType (right))))
THEN
- CodeIfSetNotEqu (op1, op2, op3)
+ CodeIfSetNotEqu (left, right, dest)
ELSE
- IF IsComposite(op1) OR IsComposite(op2)
+ IF IsComposite (GetType (left)) OR IsComposite (GetType (right))
THEN
- MetaErrorT2 (CurrentQuadToken,
+ MetaErrorT2 (combined,
'inequality tests between composite types not allowed {%1Eatd} and {%2atd}',
- op1, op2)
+ left, right)
ELSE
- ConvertBinaryOperands(location,
- tl, tr,
- ComparisonMixTypes (SkipType (GetType (op1)),
- SkipType (GetType (op2)),
- CurrentQuadToken),
- op1, op2) ;
- DoJump(location,
- BuildNotEqualTo(location, tl, tr), NIL, string(CreateLabelName(op3)))
+ ConvertBinaryOperands (location,
+ tl, tr,
+ ComparisonMixTypes (SkipType (GetType (left)),
+ SkipType (GetType (right)),
+ combined),
+ left, right) ;
+ DoJump (location, BuildNotEqualTo (location, tl, tr), NIL,
+ string (CreateLabelName (dest)))
END
END
+END PerformCodeIfNotEqu ;
+
+
+(*
+ IsValidExpressionRelOp -
+*)
+
+PROCEDURE IsValidExpressionRelOp (quad: CARDINAL) : BOOLEAN ;
+CONST
+ Verbose = FALSE ;
+VAR
+ lefttype, righttype,
+ left, right, dest, combined,
+ leftpos, rightpos, destpos : CARDINAL ;
+ overflow : BOOLEAN ;
+ op : QuadOperator ;
+BEGIN
+ (* Ensure that any remaining undeclared constant literal is declared. *)
+ GetQuadOtok (quad, combined, op,
+ left, right, dest, overflow,
+ leftpos, rightpos, destpos) ;
+ DeclareConstant (leftpos, left) ;
+ DeclareConstant (rightpos, right) ;
+ DeclareConstructor (leftpos, quad, left) ;
+ DeclareConstructor (rightpos, quad, right) ;
+ lefttype := GetType (left) ;
+ righttype := GetType (right) ;
+ IF ExpressionTypeCompatible (combined, "", left, right,
+ StrictTypeChecking, FALSE)
+ THEN
+ RETURN TRUE
+ ELSE
+ IF Verbose
+ THEN
+ MetaErrorT2 (combined,
+ 'expression mismatch between {%1Etad} and {%2tad} seen during comparison',
+ left, right)
+ END ;
+ RETURN FALSE
+ END
+END IsValidExpressionRelOp ;
+
+
+(*
+ CodeIfEqu - codes the quadruple if op1 = op2 then goto op3
+*)
+
+PROCEDURE CodeIfEqu (quad: CARDINAL) ;
+BEGIN
+ IF IsValidExpressionRelOp (quad)
+ THEN
+ PerformCodeIfEqu (quad)
+ END
+END CodeIfEqu ;
+
+
+(*
+ CodeIfNotEqu - codes the quadruple if op1 # op2 then goto op3
+*)
+
+PROCEDURE CodeIfNotEqu (quad: CARDINAL) ;
+BEGIN
+ IF IsValidExpressionRelOp (quad)
+ THEN
+ PerformCodeIfNotEqu (quad)
+ END
END CodeIfNotEqu ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3231f9f..0263074 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -12898,7 +12898,7 @@ BEGIN
PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos)
ELSIF (OperandT (2) = HashTok) OR (OperandT (2) = LessGreaterTok)
THEN
- (* are the two boolean expressions the different? *)
+ (* are the two boolean expressions different? *)
PopBool (t1, f1) ;
PopT (Tok) ;
PopBool (t2, f2) ;
diff --git a/gcc/testsuite/gm2/cse/pass/testcse54.mod b/gcc/testsuite/gm2/cse/pass/testcse54.mod
new file mode 100644
index 0000000..5cc1e64
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse54.mod
@@ -0,0 +1,7 @@
+MODULE testcse54 ;
+
+VAR
+ a: ARRAY [0..10] OF CHAR ;
+BEGIN
+ a := 'hello'
+END testcse54.
diff --git a/gcc/testsuite/gm2/iso/run/pass/array9.mod b/gcc/testsuite/gm2/iso/run/pass/array9.mod
new file mode 100644
index 0000000..dd3304e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/array9.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 Free Software Foundation, Inc. *)
+(* 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 2, 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.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE array9 ;
+
+
+PROCEDURE assign (a: ARRAY OF ARRAY OF CARDINAL) ;
+END assign ;
+
+VAR
+ e: ARRAY [1..5] OF ARRAY [0..29] OF CARDINAL ;
+BEGIN
+ assign(e)
+END array9.
diff --git a/gcc/testsuite/gm2/iso/run/pass/strcons3.mod b/gcc/testsuite/gm2/iso/run/pass/strcons3.mod
new file mode 100644
index 0000000..7950e64
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/strcons3.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2024 Free Software Foundation, Inc. *)
+(* 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 2, 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.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE strcons3 ;
+
+
+TYPE
+ NameType = ARRAY [0..24] OF CHAR ;
+ PersonType = RECORD
+ name: NameType ;
+ END ;
+VAR
+ person: PersonType ;
+BEGIN
+ person := PersonType{"Blaise Pascal"}
+END strcons3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/strcons4.mod b/gcc/testsuite/gm2/iso/run/pass/strcons4.mod
new file mode 100644
index 0000000..1c0e350
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/strcons4.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2024 Free Software Foundation, Inc. *)
+(* 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 2, 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.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE strcons4 ;
+
+
+TYPE
+ NameType = ARRAY [0..24] OF CHAR ;
+ DateType = RECORD
+ year, month, day: CARDINAL ;
+ END ;
+ PersonType = RECORD
+ name: NameType ;
+ DateOfBirth: DateType ;
+ END ;
+VAR
+ date : DateType ;
+ person: PersonType ;
+BEGIN
+ date := DateType{1623, 6, 19} ;
+ person := PersonType{"Blaise Pascal", date} ;
+END strcons4.
diff --git a/gcc/testsuite/gm2/pim/fail/badset1.mod b/gcc/testsuite/gm2/pim/fail/badset1.mod
new file mode 100644
index 0000000..de56fe3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badset1.mod
@@ -0,0 +1,13 @@
+MODULE badset1 ;
+
+FROM libc IMPORT printf ;
+
+VAR
+ s: SET OF [1..10] ;
+ c: CARDINAL ;
+BEGIN
+ IF c = s
+ THEN
+ printf ("broken\n")
+ END
+END badset1.
diff --git a/gcc/testsuite/gm2/pim/fail/badset2.mod b/gcc/testsuite/gm2/pim/fail/badset2.mod
new file mode 100644
index 0000000..b8c798f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badset2.mod
@@ -0,0 +1,13 @@
+MODULE badset2 ;
+
+FROM libc IMPORT printf ;
+
+VAR
+ s: SET OF [1..10] ;
+ c: CARDINAL ;
+BEGIN
+ IF c # s
+ THEN
+ printf ("broken\n")
+ END
+END badset2.
diff --git a/gcc/testsuite/gm2/pim/fail/badset3.mod b/gcc/testsuite/gm2/pim/fail/badset3.mod
new file mode 100644
index 0000000..fcbf177
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badset3.mod
@@ -0,0 +1,11 @@
+MODULE badset3 ;
+
+
+VAR
+ s10: SET OF [1..10] ;
+ s20: SET OF [1..20] ;
+BEGIN
+ IF s10 = s20
+ THEN
+ END
+END badset3.
diff --git a/gcc/testsuite/gm2/pim/fail/badset4.mod b/gcc/testsuite/gm2/pim/fail/badset4.mod
new file mode 100644
index 0000000..2382e4e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badset4.mod
@@ -0,0 +1,11 @@
+MODULE badset4 ;
+
+
+VAR
+ s10: SET OF [1..10] ;
+ s20: SET OF [1..20] ;
+BEGIN
+ IF s10 > s20
+ THEN
+ END
+END badset4.