public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-9463] PR modula2/114333 set type comparison against a cardinal should cause an error
@ 2024-03-14 11:24 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2024-03-14 11:24 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:b7f70cfdb6f7ab369ecca14a99a0064d2a11ddd2
commit r14-9463-gb7f70cfdb6f7ab369ecca14a99a0064d2a11ddd2
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Thu Mar 14 11:23:42 2024 +0000
PR modula2/114333 set type comparison against a cardinal should cause an error
The type checker M2Check.mod needs extending to detect if a set, array or
record is in either operand at the end of the cascaded test list.
gcc/m2/ChangeLog:
PR modula2/114333
* gm2-compiler/M2Check.mod (checkUnbounded): New procedure
function.
(checkArrayTypeEquivalence): Extend checking to cover unbounded
arrays, arrays and constants.
(IsTyped): Simplified the expression and corrected a test for
IsConstructor.
(checkTypeKindViolation): New procedure function.
(doCheckPair): Call checkTypeKindViolation.
* gm2-compiler/M2GenGCC.mod (CodeStatement): Remove parameters
to CodeEqu and CodeNotEqu.
(PerformCodeIfEqu): New procedure.
(CodeIfEqu): Rewrite.
(PerformCodeIfNotEqu): New procedure.
(CodeIfNotEqu): Rewrite.
* gm2-compiler/M2Quads.mod (BuildRelOpFromBoolean): Correct
comment.
gcc/testsuite/ChangeLog:
PR modula2/114333
* gm2/cse/pass/testcse54.mod: New test.
* gm2/iso/run/pass/array9.mod: New test.
* gm2/iso/run/pass/strcons3.mod: New test.
* gm2/iso/run/pass/strcons4.mod: New test.
* gm2/pim/fail/badset1.mod: New test.
* gm2/pim/fail/badset2.mod: New test.
* gm2/pim/fail/badset3.mod: New test.
* gm2/pim/fail/badset4.mod: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Check.mod | 111 +++++++++++++--
gcc/m2/gm2-compiler/M2GenGCC.mod | 212 ++++++++++++++++++----------
gcc/m2/gm2-compiler/M2Quads.mod | 2 +-
gcc/testsuite/gm2/cse/pass/testcse54.mod | 7 +
gcc/testsuite/gm2/iso/run/pass/array9.mod | 28 ++++
gcc/testsuite/gm2/iso/run/pass/strcons3.mod | 30 ++++
gcc/testsuite/gm2/iso/run/pass/strcons4.mod | 36 +++++
gcc/testsuite/gm2/pim/fail/badset1.mod | 13 ++
gcc/testsuite/gm2/pim/fail/badset2.mod | 13 ++
gcc/testsuite/gm2/pim/fail/badset3.mod | 11 ++
gcc/testsuite/gm2/pim/fail/badset4.mod | 11 ++
11 files changed, 383 insertions(+), 91 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 5b45ad39c11..20d463d207b 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
@@ -772,6 +825,30 @@ BEGIN
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 aeba48d356e..7633b8425ae 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 3231f9f5606..0263074d845 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 00000000000..5cc1e64571a
--- /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 00000000000..dd3304efb82
--- /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 00000000000..7950e64900f
--- /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 00000000000..1c0e350c42f
--- /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 00000000000..de56fe3ab1c
--- /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 00000000000..b8c798fa7dc
--- /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 00000000000..fcbf1775c21
--- /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 00000000000..2382e4ea699
--- /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.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-03-14 11:24 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-03-14 11:24 [gcc r14-9463] PR modula2/114333 set type comparison against a cardinal should cause an error 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).