public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7652] modula2: Uninitialized variable static analysis improvements
@ 2023-07-30 10:01 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-07-30 10:01 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d8a0dcd146dd95e2b6b85cf82c445214d364cf3b
commit r13-7652-gd8a0dcd146dd95e2b6b85cf82c445214d364cf3b
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Sun Jul 30 11:00:24 2023 +0100
modula2: Uninitialized variable static analysis improvements
This patch fixes many limitations of the uninitialized static analysis.
NEW is understood, local variable pointers and non var parameters
will be tracked.
gcc/ChangeLog:
* doc/gm2.texi (Semantic checking): Change example testwithptr
to testnew6.
gcc/m2/ChangeLog:
* Make-lang.in: Minor formatting change.
* gm2-compiler/M2GCCDeclare.mod
(DeclareUnboundedProcedureParameters): Rename local variables.
(WalkUnboundedProcedureParameters): Rename local variables.
(DoVariableDeclaration): Avoid declaration of a variable if
it is on the heap (used by static analysis only).
* gm2-compiler/M2GenGCC.mod: Formatting.
* gm2-compiler/M2Quads.def (GetQuadTrash): New procedure function.
* gm2-compiler/M2Quads.mod (GetQuadTrash): New procedure function.
(QuadFrame): Add Trash field.
(BuildRealFuncProcCall): Detect ALLOCATE and DEALLOCATE and create
a heap variable for parameter 1 saving it as the trashed variable
for static analysis.
(GenQuadOTrash): New procedure.
(DisplayQuadRange): Bugfix. Write the scope number.
* gm2-compiler/M2SymInit.mod: Rewritten to separate LValue
equivalence from LValue to RValue pairings. Comprehensive
detection of variant record implemented. Allow dereferencing
of pointers through LValue/RValue chains.
* gm2-compiler/SymbolTable.def (PutVarHeap): New procedure.
(IsVarHeap): New procedure function.
(ForeachParamSymDo): New procedure.
* gm2-compiler/SymbolTable.mod (PutVarHeap): New procedure.
(IsVarHeap): New procedure function.
(ForeachParamSymDo): New procedure.
(MakeVariableForParam): Reformatted.
(CheckForUnknownInModule): Reformatted.
(SymVar): Add field Heap.
(MakeVar): Assign Heap to FALSE.
gcc/testsuite/ChangeLog:
* gm2/switches/uninit-variable-checking/pass/assignparam.mod: New test.
* gm2/switches/uninit-variable-checking/pass/tiny.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp:
New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp:
New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testnew5.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod: New test.
(cherry picked from commit b80e3c468e373cc6fd4e41a5879dbca95a40ac8c)
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/doc/gm2.texi | 25 +-
gcc/m2/Make-lang.in | 3 +-
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 44 +-
gcc/m2/gm2-compiler/M2GenGCC.mod | 4 +-
gcc/m2/gm2-compiler/M2Quads.def | 10 +-
gcc/m2/gm2-compiler/M2Quads.mod | 70 ++-
gcc/m2/gm2-compiler/M2SymInit.mod | 520 ++++++++++++++++-----
gcc/m2/gm2-compiler/SymbolTable.def | 25 +
gcc/m2/gm2-compiler/SymbolTable.mod | 87 +++-
.../uninit-variable-checking/pass/assignparam.mod | 31 ++
.../uninit-variable-checking/pass/tiny.mod | 13 +
...es-uninit-variable-checking-procedures-fail.exp | 37 ++
.../procedures/fail/testnew.mod | 31 ++
.../procedures/fail/testnew2.mod | 31 ++
.../procedures/fail/testnew3.mod | 34 ++
.../procedures/fail/testnew4.mod | 34 ++
.../procedures/fail/testnew5.mod | 31 ++
.../procedures/fail/testnew6.mod | 27 ++
.../procedures/fail/testptrptr.mod | 32 ++
.../procedures/pass/assignparam2.mod | 31 ++
...es-uninit-variable-checking-procedures-pass.exp | 37 ++
.../procedures/pass/testnew5.mod | 27 ++
.../procedures/pass/testnew6.mod | 27 ++
.../procedures/pass/testparamlvalue.mod | 26 ++
.../procedures/pass/testparamrvalue.mod | 26 ++
.../procedures/pass/testproc.mod | 15 +
.../procedures/pass/testptrptr.mod | 29 ++
27 files changed, 1140 insertions(+), 167 deletions(-)
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index 8d5d95f9fc7..9f7f8ce6e99 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -1471,7 +1471,7 @@ plugin is invoked.
The @samp{-Wuninit-variable-checking} can be used to identify
uninitialized variables within the first basic block in a procedure.
The checking is limited to variables so long as they are
-not an array or set or a variant record.
+not an array or set or a variant record or var parameter.
The following example detects whether a sub component within a record
is uninitialized.
@@ -1551,22 +1551,20 @@ access expression before it has been initialized
@end example
@example
-MODULE testwithptr ;
+MODULE testnew6 ;
-FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE ;
TYPE
- PtrToVec = POINTER TO Vec ;
- Vec = RECORD
- x, y: CARDINAL ;
- END ;
+ PtrToVec = POINTER TO RECORD
+ x, y: INTEGER ;
+ END ;
PROCEDURE test ;
VAR
p: PtrToVec ;
- v: Vec ;
BEGIN
- p := ADR (v) ;
+ NEW (p) ;
WITH p^ DO
x := 1 ;
x := 2 (* Deliberate typo, user meant y. *)
@@ -1576,16 +1574,17 @@ BEGIN
END
END test ;
+
BEGIN
test
-END testwithptr.
+END testnew6.
@end example
@example
-gm2 -c -Wuninit-variable-checking testwithptr.mod
-testwithptr.mod:26:9: warning: In procedure ‘test’: attempting to
+$ gm2 -g -c -Wuninit-variable-checking testnew6.mod
+testnew6.mod:19:9: warning: In procedure ‘test’: attempting to
access expression before it has been initialized
- 26 | IF p^.y = 2
+ 19 | IF p^.y = 2
| ~~^~
@end example
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 8b2c022c7f3..56af973e6f1 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -462,7 +462,8 @@ GM2_G=-g -fm2-g
GM2_CPP=
# GM2_DEBUG_STRMEM=-fcpp
GM2_DEBUG_STRMEM=
-GM2_FLAGS=-Wunused-variable -Wuninit-variable-checking -fsoft-check-all \
+GM2_FLAGS=-Wunused-variable -Wuninit-variable-checking \
+ -fsoft-check-all \
-fno-return -Wreturn-type \
$(GM2_G) $(GM2_O) \
-funbounded-by-reference -fpim -fextended-opaque \
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index eaa3255f623..92de4b4b2e6 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -95,7 +95,7 @@ FROM SymbolTable IMPORT NulSym,
IsProcedureReachable, IsParameter, IsConstLit,
IsDummy, IsVarAParam, IsProcedureVariable,
IsGnuAsm, IsGnuAsmVolatile, IsObject, IsTuple,
- IsError, IsHiddenType,
+ IsError, IsHiddenType, IsVarHeap,
IsComponent, IsPublic, IsExtern, IsCtor,
GetMainModule, GetBaseModule, GetModule, GetLocalSym,
PutModuleFinallyFunction,
@@ -2118,7 +2118,8 @@ END WalkTypeInfo ;
PROCEDURE DeclareUnboundedProcedureParameters (sym: WORD) ;
VAR
- son, type,
+ param,
+ type,
p, i : CARDINAL ;
location : location_t ;
BEGIN
@@ -2129,8 +2130,8 @@ BEGIN
WHILE i>0 DO
IF IsUnboundedParam(sym, i)
THEN
- son := GetNthParam(sym, i) ;
- type := GetSType(son) ;
+ param := GetNthParam(sym, i) ;
+ type := GetSType(param) ;
TraverseDependants(type) ;
IF GccKnowsAbout(type)
THEN
@@ -2138,8 +2139,8 @@ BEGIN
BuildTypeDeclaration(location, Mod2Gcc(type))
END
ELSE
- son := GetNth(sym, i) ;
- type := GetSType(son) ;
+ param := GetNth(sym, i) ;
+ type := GetSType(param) ;
TraverseDependants(type)
END ;
DEC(i)
@@ -2154,31 +2155,24 @@ END DeclareUnboundedProcedureParameters ;
PROCEDURE WalkUnboundedProcedureParameters (sym: WORD) ;
VAR
- son,
+ param,
type,
p, i: CARDINAL ;
BEGIN
- IF IsProcedure(sym)
+ IF IsProcedure (sym)
THEN
- p := NoOfParam(sym) ;
+ p := NoOfParam (sym) ;
i := p ;
WHILE i>0 DO
- IF IsUnboundedParam(sym, i)
+ IF IsUnboundedParam (sym, i)
THEN
- son := GetNthParam(sym, i) ;
- type := GetSType(son) ;
- WalkTypeInfo(type) ;
-(*
- type := GetUnboundedRecordType(type) ;
- Assert(IsRecord(type)) ;
- RecordNotPacked(type) (* which is never packed. *)
-*)
+ param := GetNthParam (sym, i)
ELSE
- son := GetNth(sym, i) ;
- type := GetSType(son) ;
- WalkTypeInfo(type)
+ param := GetNth (sym, i)
END ;
- DEC(i)
+ type := GetSType (param) ;
+ WalkTypeInfo (type) ;
+ DEC (i)
END
END
END WalkUnboundedProcedureParameters ;
@@ -3173,7 +3167,7 @@ VAR
varType : CARDINAL ;
location: location_t ;
BEGIN
- IF IsComponent (var)
+ IF IsComponent (var) OR IsVarHeap (var)
THEN
RETURN
END ;
@@ -3909,6 +3903,10 @@ BEGIN
THEN
printf0('component ')
END ;
+ IF IsVarHeap (sym)
+ THEN
+ printf0('heap ')
+ END ;
printf0 ('\n') ;
PrintInitialized (sym) ;
IncludeType(l, sym)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 0955106dbb6..d701543df76 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -1362,7 +1362,9 @@ BEGIN
(* now assign param.Addr := ADR(NewArray) *)
BuildAssignmentStatement (location,
- BuildComponentRef (location, Mod2Gcc (param), Mod2Gcc (GetUnboundedAddressOffset (UnboundedType))),
+ BuildComponentRef (location,
+ Mod2Gcc (param),
+ Mod2Gcc (GetUnboundedAddressOffset (UnboundedType))),
NewArray)
END MakeCopyUse ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index cd011baf549..3a4059513cd 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -145,7 +145,8 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
IsAutoPushOn, PushAutoOn, PushAutoOff, PopAuto,
PushInConstExpression, PopInConstExpression,
IsInConstExpression,
- MustCheckOverflow, BuildAsmElement, BuildAsmTrash ;
+ MustCheckOverflow, BuildAsmElement, BuildAsmTrash,
+ GetQuadTrash ;
TYPE
@@ -2771,4 +2772,11 @@ PROCEDURE BuildAsmElement (input, output: BOOLEAN) ;
PROCEDURE BuildAsmTrash ;
+(*
+ GetQuadTrash - return the symbol associated with the trashed operand.
+*)
+
+PROCEDURE GetQuadTrash (quad: CARDINAL) : CARDINAL ;
+
+
END M2Quads.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 5ed22528763..db5513d6787 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -85,6 +85,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
PutPriority, GetPriority,
PutProcedureBegin, PutProcedureEnd,
PutVarConst, IsVarConst,
+ PutVarHeap,
IsVarParam, IsProcedure, IsPointer, IsParameter,
IsUnboundedParam, IsEnumeration, IsDefinitionForC,
IsVarAParam, IsVarient, IsLegal,
@@ -290,6 +291,7 @@ TYPE
Operand1 : CARDINAL ;
Operand2 : CARDINAL ;
Operand3 : CARDINAL ;
+ Trash : CARDINAL ;
Next : CARDINAL ; (* Next quadruple. *)
LineNo : CARDINAL ; (* Line No of source text. *)
TokenNo : CARDINAL ; (* Token No of source text. *)
@@ -1481,6 +1483,7 @@ BEGIN
Operand1 := 0 ;
Operand2 := 0 ;
Operand3 := 0 ;
+ Trash := 0 ;
op1pos := UnknownTokenNo ;
op2pos := UnknownTokenNo ;
op3pos := UnknownTokenNo
@@ -5174,17 +5177,24 @@ END BuildRealProcedureCall ;
PROCEDURE BuildRealFuncProcCall (tokno: CARDINAL; IsFunc, IsForC: BOOLEAN) ;
VAR
+ AllocateProc,
+ DeallocateProc,
ForcedFunc,
ParamConstant : BOOLEAN ;
+ trash,
resulttok,
paramtok,
proctok,
NoOfParameters,
i, pi,
+ ParamType,
+ Param1, (* Used to remember first param for allocate/deallocate. *)
ReturnVar,
ProcSym,
Proc : CARDINAL ;
BEGIN
+ Param1 := NulSym ;
+ ParamType := NulSym ;
CheckProcedureParameters (IsForC) ;
PopT (NoOfParameters) ;
PushT (NoOfParameters) ; (* Restore stack to original state. *)
@@ -5197,6 +5207,8 @@ BEGIN
paramtok := proctok ;
ProcSym := SkipConst (ProcSym) ;
ForcedFunc := FALSE ;
+ AllocateProc := FALSE ;
+ DeallocateProc := FALSE ;
IF IsVar (ProcSym)
THEN
(* Procedure Variable ? *)
@@ -5204,7 +5216,9 @@ BEGIN
ParamConstant := FALSE
ELSE
Proc := ProcSym ;
- ParamConstant := IsProcedureBuiltin (Proc)
+ ParamConstant := IsProcedureBuiltin (Proc) ;
+ AllocateProc := GetSymName (Proc) = MakeKey('ALLOCATE') ;
+ DeallocateProc := GetSymName (Proc) = MakeKey('DEALLOCATE')
END ;
IF IsFunc
THEN
@@ -5229,6 +5243,10 @@ BEGIN
ForcedFunc := TRUE
END
END ;
+ IF AllocateProc OR DeallocateProc
+ THEN
+ Param1 := OperandT (NoOfParameters+1) (* Remember this before manipulating. *)
+ END ;
ManipulateParameters (IsForC) ;
CheckParameterOrdinals ;
PopT(NoOfParameters) ;
@@ -5244,7 +5262,21 @@ BEGIN
pi := 1 ; (* stack index referencing stacked parameter, i *)
WHILE i>0 DO
paramtok := OperandTtok (pi) ;
- GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE) ;
+ IF (AllocateProc OR DeallocateProc) AND (i = 1) AND (Param1 # NulSym)
+ THEN
+ ParamType := GetItemPointedTo (Param1) ;
+ IF ParamType = NulSym
+ THEN
+ GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE)
+ ELSE
+ trash := MakeTemporary (paramtok, RightValue) ;
+ PutVar (trash, ParamType) ;
+ PutVarHeap (trash, TRUE) ;
+ GenQuadOTrash (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE, trash)
+ END
+ ELSE
+ GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE)
+ END ;
IF NOT IsConst (OperandT (pi))
THEN
ParamConstant := FALSE
@@ -6787,7 +6819,7 @@ BEGIN
THEN
RETURN GetItemPointedTo (GetSType (Sym))
ELSE
- InternalError ('expecting a pointer or variable symbol')
+ RETURN NulSym
END
END GetItemPointedTo ;
@@ -13079,6 +13111,19 @@ END MakeOp ;
PROCEDURE GenQuadO (TokPos: CARDINAL;
Operation: QuadOperator;
Op1, Op2, Op3: CARDINAL; overflow: BOOLEAN) ;
+BEGIN
+ GenQuadOTrash (TokPos, Operation, Op1, Op2, Op3, overflow, NulSym)
+END GenQuadO ;
+
+
+(*
+ GenQuadOTrash - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
+*)
+
+PROCEDURE GenQuadOTrash (TokPos: CARDINAL;
+ Operation: QuadOperator;
+ Op1, Op2, Op3: CARDINAL;
+ overflow: BOOLEAN; trash: CARDINAL) ;
VAR
f: QuadFrame ;
BEGIN
@@ -13093,6 +13138,7 @@ BEGIN
PutQuadO (NextQuad, Operation, Op1, Op2, Op3, overflow) ;
f := GetQF (NextQuad) ;
WITH f^ DO
+ Trash := trash ;
Next := 0 ;
LineNo := GetLineNo () ;
IF TokPos = UnknownTokenNo
@@ -13109,7 +13155,21 @@ BEGIN
(* DisplayQuad(NextQuad) ; *)
NewQuad (NextQuad)
END
-END GenQuadO ;
+END GenQuadOTrash ;
+
+
+(*
+ GetQuadTrash - return the symbol associated with the trashed operand.
+*)
+
+PROCEDURE GetQuadTrash (quad: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (quad) ;
+ LastQuadNo := quad ;
+ RETURN f^.Trash
+END GetQuadTrash ;
(*
@@ -13194,7 +13254,7 @@ PROCEDURE DisplayQuadRange (scope: CARDINAL; start, end: CARDINAL) ;
VAR
f: QuadFrame ;
BEGIN
- printf0 ('Quadruples for scope: ') ; WriteOperand (scope) ; printf0 ('\n') ;
+ printf1 ('Quadruples for scope: %d\n', scope) ;
WHILE (start <= end) AND (start # 0) DO
DisplayQuad (start) ;
f := GetQF (start) ;
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod
index a5457ecbebd..f617c40d1d0 100644
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -25,7 +25,7 @@ FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM M2Debug IMPORT Assert ;
FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
FROM libc IMPORT printf ;
-FROM NameKey IMPORT Name, NulName, KeyToCharStar ;
+FROM NameKey IMPORT Name, NulName, KeyToCharStar, MakeKey ;
FROM M2Options IMPORT UninitVariableChecking, UninitVariableConditionalChecking,
CompilerDebugging ;
@@ -41,6 +41,7 @@ FROM M2BasicBlock IMPORT BasicBlock,
ForeachBasicBlockDo ;
IMPORT Indexing ;
+FROM Indexing IMPORT Index ;
FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList,
IsItemInList, IncludeItemIntoList, NoOfItemsInList,
@@ -52,15 +53,19 @@ FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType,
VarCheckReadInit, VarInitState, PutVarInitialized,
PutVarFieldInitialized, GetVarFieldInitialized,
IsConst, IsConstString, NoOfParam, IsVarParam,
- ForeachLocalSymDo, IsTemporary, ModeOfAddr,
+ ForeachLocalSymDo, ForeachParamSymDo,
+ IsTemporary, ModeOfAddr,
IsReallyPointer, IsUnbounded,
IsVarient, IsFieldVarient, GetVarient,
- IsVarArrayRef ;
+ IsVarArrayRef, GetSymName,
+ IsType, IsPointer,
+ GetParameterShadowVar, IsParameter, GetLType ;
FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad,
IsNewLocalVar, IsReturn, IsKillLocalVar, IsConditional,
IsUnConditional, IsBackReference, IsCall, IsGoto,
- GetM2OperatorDesc, Opposite, DisplayQuadRange ;
+ GetM2OperatorDesc, Opposite, DisplayQuadRange,
+ GetQuadTrash ;
FROM M2Printf IMPORT printf0, printf1, printf2 ;
FROM M2GCCDeclare IMPORT PrintSym ;
@@ -104,21 +109,24 @@ TYPE
(* Does it end with a conditional? *)
endCond,
(* Does it form part of a loop? *)
- topOfLoop: BOOLEAN ;
+ topOfLoop : BOOLEAN ;
+ trashQuad,
indexBB,
nextQuad,
condQuad,
nextBB,
- condBB : CARDINAL ;
- next : bbEntry ;
+ condBB : CARDINAL ;
+ next : bbEntry ;
END ;
VAR
- aliasArray: Indexing.Index ;
- freeList : symAlias ;
- bbArray : Indexing.Index ;
- bbFreeList: bbEntry ;
- errorList : List ; (* Ensure that we only generate one set of warnings per token. *)
+ IndirectArray,
+ LArray : Indexing.Index ;
+ freeList : symAlias ;
+ bbArray : Indexing.Index ;
+ bbFreeList : bbEntry ;
+ ignoreList,
+ errorList : List ; (* Ensure that we only generate one set of warnings per token. *)
(*
@@ -418,10 +426,10 @@ END IsLocalVar ;
RecordFieldContainsVarient -
*)
-PROCEDURE RecordFieldContainsVarient (sym: CARDINAL) : BOOLEAN ;
+PROCEDURE RecordFieldContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
BEGIN
Assert (IsRecordField (sym)) ;
- IF ContainsVariant (GetSType (sym))
+ IF doContainsVariant (GetSType (sym), visited)
THEN
RETURN TRUE
END ;
@@ -430,37 +438,125 @@ END RecordFieldContainsVarient ;
(*
- ContainsVariant - returns TRUE if type sym contains a variant record.
+ RecordContainsVarient -
*)
-PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ;
+PROCEDURE RecordContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
VAR
i,
fieldsym,
fieldtype: CARDINAL ;
BEGIN
- IF IsRecord (sym)
- THEN
- i := 1 ;
- REPEAT
- fieldsym := GetNth (sym, i) ;
- IF fieldsym # NulSym
+ Assert (IsRecord (sym)) ;
+ i := 1 ;
+ REPEAT
+ fieldsym := GetNth (sym, i) ;
+ IF fieldsym # NulSym
+ THEN
+ IF IsRecordField (fieldsym)
THEN
- IF IsRecordField (fieldsym)
- THEN
- IF RecordFieldContainsVarient (fieldsym)
- THEN
- RETURN TRUE
- END
- ELSIF IsVarient (fieldsym)
+ IF RecordFieldContainsVarient (fieldsym, visited)
THEN
RETURN TRUE
- END ;
- INC (i)
- END
- UNTIL fieldsym = NulSym
+ END
+ ELSIF IsVarient (fieldsym)
+ THEN
+ RETURN TRUE
+ END ;
+ INC (i)
+ END
+ UNTIL fieldsym = NulSym ;
+ RETURN FALSE
+END RecordContainsVarient ;
+
+
+(*
+ VarContainsVarient -
+*)
+
+PROCEDURE VarContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
+BEGIN
+ Assert (IsVar (sym)) ;
+ RETURN doContainsVariant (GetSType (sym), visited)
+END VarContainsVarient ;
+
+
+(*
+ TypeContainsVarient -
+*)
+
+PROCEDURE TypeContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
+BEGIN
+ Assert (IsType (sym)) ;
+ RETURN doContainsVariant (GetSType (sym), visited)
+END TypeContainsVarient ;
+
+
+(*
+ ArrayContainsVarient -
+*)
+
+PROCEDURE ArrayContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
+BEGIN
+ Assert (IsArray (sym)) ;
+ RETURN doContainsVariant (GetSType (sym), visited)
+END ArrayContainsVarient ;
+
+
+(*
+ PointerContainsVarient -
+*)
+
+PROCEDURE PointerContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
+BEGIN
+ Assert (IsPointer (sym)) ;
+ RETURN doContainsVariant (GetSType (sym), visited)
+END PointerContainsVarient ;
+
+
+(*
+ doContainsVariant -
+*)
+
+PROCEDURE doContainsVariant (sym: CARDINAL; visited: List) : BOOLEAN ;
+BEGIN
+ IF (sym # NulSym) AND (NOT IsItemInList (visited, sym))
+ THEN
+ IncludeItemIntoList (visited, sym) ;
+ IF IsVar (sym)
+ THEN
+ RETURN VarContainsVarient (sym, visited)
+ ELSIF IsRecord (sym)
+ THEN
+ RETURN RecordContainsVarient (sym, visited)
+ ELSIF IsPointer (sym)
+ THEN
+ RETURN PointerContainsVarient (sym, visited)
+ ELSIF IsArray (sym)
+ THEN
+ RETURN ArrayContainsVarient (sym, visited)
+ ELSIF IsType (sym)
+ THEN
+ RETURN TypeContainsVarient (sym, visited)
+ END
END ;
RETURN FALSE
+END doContainsVariant ;
+
+
+(*
+ ContainsVariant - returns TRUE if type sym contains a variant record.
+*)
+
+PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ;
+VAR
+ visited: List ;
+ result : BOOLEAN ;
+BEGIN
+ InitList (visited) ;
+ result := doContainsVariant (sym, visited) ;
+ KillList (visited) ;
+ RETURN result
END ContainsVariant ;
@@ -656,9 +752,12 @@ END CheckDeferredRecordAccess ;
PROCEDURE SetVarUninitialized (sym: CARDINAL) ;
BEGIN
- IF IsVar (sym) AND (NOT IsUnbounded (GetSType (sym))) AND (NOT IsVarAParam (sym))
+ IF IsVar (sym)
THEN
- VarInitState (sym)
+ IF NOT IsUnbounded (GetSType (sym))
+ THEN
+ VarInitState (sym)
+ END
END
END SetVarUninitialized ;
@@ -667,19 +766,21 @@ END SetVarUninitialized ;
ComponentFindVar -
*)
-PROCEDURE ComponentFindVar (sym: CARDINAL) : CARDINAL ;
+PROCEDURE ComponentFindVar (sym: CARDINAL; VAR lvalue: BOOLEAN) : CARDINAL ;
VAR
nsym,
i : CARDINAL ;
BEGIN
i := 1 ;
REPEAT
- nsym := getAlias (GetNth (sym, i)) ;
+ nsym := GetNth (sym, i) ;
+ lvalue := GetMode (nsym) = LeftValue ;
+ nsym := getLAlias (nsym) ;
IF (nsym # NulSym) AND IsVar (nsym)
THEN
IF (nsym # sym) AND IsComponent (nsym)
THEN
- RETURN ComponentFindVar (nsym)
+ RETURN ComponentFindVar (nsym, lvalue)
ELSE
RETURN nsym
END
@@ -741,18 +842,35 @@ BEGIN
END ComponentBuildFieldList ;
+(*
+ deRefComponent -
+*)
+
+PROCEDURE deRefComponent (component: CARDINAL; lvalue: BOOLEAN) : CARDINAL ;
+BEGIN
+ IF lvalue
+ THEN
+ RETURN getContent (component)
+ ELSE
+ RETURN component
+ END
+END deRefComponent ;
+
+
(*
SetVarComponentInitialized -
*)
PROCEDURE SetVarComponentInitialized (sym: CARDINAL) ;
VAR
+ lvalue: BOOLEAN ;
i, n,
fsym,
- vsym: CARDINAL ;
- lst : List ;
+ vsym : CARDINAL ;
+ lst : List ;
BEGIN
- vsym := ComponentFindVar (sym) ;
+ vsym := ComponentFindVar (sym, lvalue) ;
+ vsym := deRefComponent (vsym, lvalue) ;
IF vsym # NulSym
THEN
IF Debugging
@@ -795,26 +913,34 @@ END SetVarComponentInitialized ;
PROCEDURE GetVarComponentInitialized (sym: CARDINAL) : BOOLEAN ;
VAR
- init: BOOLEAN ;
- vsym: CARDINAL ;
- lst : List ;
-BEGIN
- init := FALSE ;
- vsym := ComponentFindVar (sym) ;
- IF vsym # NulSym
+ lvalue,
+ init : BOOLEAN ;
+ component,
+ vsym : CARDINAL ;
+ lst : List ;
+BEGIN
+ component := ComponentFindVar (sym, lvalue) ;
+ IF IsItemInList (ignoreList, component) OR IsExempt (component)
THEN
- IF IsExempt (vsym)
+ RETURN TRUE
+ ELSE
+ init := FALSE ;
+ vsym := deRefComponent (component, lvalue) ;
+ IF vsym # NulSym
THEN
- init := TRUE
- ELSE
- (* Create list representing how the field is accessed. *)
- lst := ComponentCreateFieldList (sym) ;
- (* Now obtain the mark indicating whether this field was initialized. *)
- init := GetVarFieldInitialized (vsym, RightValue, lst) ;
- KillList (lst)
- END
- END ;
- RETURN init
+ IF IsExempt (vsym)
+ THEN
+ init := TRUE
+ ELSE
+ (* Create list representing how the field is accessed. *)
+ lst := ComponentCreateFieldList (sym) ;
+ (* Now obtain the mark indicating whether this field was initialized. *)
+ init := GetVarFieldInitialized (vsym, RightValue, lst) ;
+ KillList (lst)
+ END
+ END ;
+ RETURN init
+ END
END GetVarComponentInitialized ;
@@ -841,6 +967,7 @@ PROCEDURE SetVarInitialized (sym: CARDINAL; canDereference: BOOLEAN) ;
BEGIN
IF IsVar (sym)
THEN
+ RemoveItemFromList (ignoreList, sym) ;
IF IsComponent (sym)
THEN
Trace ("SetVarInitialized sym %d is a component and calling SetVarComponentInitialized", sym);
@@ -913,10 +1040,12 @@ END GetVarInitialized ;
PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ;
BEGIN
RETURN (sym # NulSym) AND IsVar (sym) AND
- (IsGlobalVar (sym) OR IsVarAParam (sym) OR
- ContainsVariant (GetSType (sym)) OR
+ (IsGlobalVar (sym) OR
+ (IsVarAParam (sym) AND (GetMode (sym) = LeftValue)) OR
+ ContainsVariant (sym) OR
IsArray (GetSType (sym)) OR IsSet (GetSType (sym)) OR
- IsUnbounded (GetSType (sym)) OR IsVarArrayRef (sym))
+ IsUnbounded (GetSType (sym)) OR IsVarArrayRef (sym) OR
+ IsItemInList (ignoreList, sym))
END IsExempt ;
@@ -964,8 +1093,8 @@ BEGIN
CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE, warning, bblst, i) ;
CheckDeferredRecordAccess (procSym, lhstok, lhs, FALSE, warning, bblst, i) ;
(* Now see if we know what lhs is pointing to and set fields if necessary. *)
- vsym := getAlias (lhs) ;
- IF (vsym # lhs) AND (GetSType (vsym) = type)
+ vsym := getContent (getLAlias (lhs)) ;
+ IF (vsym # NulSym) AND (vsym # lhs) AND (GetSType (vsym) = type)
THEN
IF IsRecord (type)
THEN
@@ -990,10 +1119,20 @@ END CheckXIndr ;
PROCEDURE CheckIndrX (procSym, lhstok, lhs, type, rhstok, rhs: CARDINAL;
warning: BOOLEAN;
lst: List; i: CARDINAL) ;
+VAR
+ content: CARDINAL ;
BEGIN
CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE, warning, lst, i) ;
- CheckDeferredRecordAccess (procSym, rhstok, rhs, TRUE, warning, lst, i) ;
- SetVarInitialized (lhs, IsVarAParam (rhs))
+ content := getContent (getLAlias (rhs)) ;
+ IF content = NulSym
+ THEN
+ IncludeItemIntoList (ignoreList, lhs)
+ ELSE
+ CheckDeferredRecordAccess (procSym, rhstok, content, TRUE, warning, lst, i) ;
+ (* SetVarInitialized (lhs, IsVarAParam (rhs)) -- was -- *)
+ (* SetVarInitialized (lhs, FALSE) -- was -- *)
+ SetVarInitialized (lhs, VarCheckReadInit (content, RightValue))
+ END
END CheckIndrX ;
@@ -1014,22 +1153,27 @@ END CheckRecordField ;
PROCEDURE CheckBecomes (procSym, destok, des, exprtok, expr: CARDINAL;
warning: BOOLEAN; bblst: List; i: CARDINAL) ;
VAR
- lst : List ;
- vsym: CARDINAL ;
+ lvalue: BOOLEAN ;
+ lst : List ;
+ vsym : CARDINAL ;
BEGIN
CheckDeferredRecordAccess (procSym, exprtok, expr, FALSE, warning, bblst, i) ;
- SetupAlias (des, expr) ;
+ SetupLAlias (des, expr) ;
SetVarInitialized (des, FALSE) ;
(* Now see if we know what lhs is pointing to and set fields if necessary. *)
IF IsComponent (des)
THEN
- vsym := ComponentFindVar (des) ;
- (* Set only the field assigned in vsym as initialized. *)
- lst := ComponentCreateFieldList (des) ;
- IF PutVarFieldInitialized (vsym, RightValue, lst)
+ vsym := ComponentFindVar (des, lvalue) ;
+ vsym := deRefComponent (vsym, lvalue) ;
+ IF vsym # NulSym
THEN
- END ;
- KillList (lst)
+ (* Set only the field assigned in vsym as initialized. *)
+ lst := ComponentCreateFieldList (des) ;
+ IF PutVarFieldInitialized (vsym, RightValue, lst)
+ THEN
+ END ;
+ KillList (lst)
+ END
END
END CheckBecomes ;
@@ -1050,10 +1194,10 @@ END CheckComparison ;
CheckAddr -
*)
-PROCEDURE CheckAddr (procSym, op1tok, op1, op3tok, op3: CARDINAL) ;
+PROCEDURE CheckAddr (procSym, ptrtok, ptr, contenttok, content: CARDINAL) ;
BEGIN
- SetVarInitialized (op1, GetVarInitialized (op3)) ;
- SetupAlias (op1, op3)
+ SetVarInitialized (ptr, GetVarInitialized (content)) ;
+ SetupIndr (ptr, content)
END CheckAddr ;
@@ -1366,6 +1510,64 @@ BEGIN
END DumpBBSequence ;
+(*
+ trashParam -
+*)
+
+PROCEDURE trashParam (trashQuad: CARDINAL) ;
+VAR
+ op : QuadOperator ;
+ op1, op2, op3: CARDINAL ;
+ heapSym, ptr : CARDINAL ;
+BEGIN
+ IF trashQuad # 0
+ THEN
+ GetQuad (trashQuad, op, op1, op2, op3) ;
+ heapSym := GetQuadTrash (trashQuad) ;
+ IF Debugging
+ THEN
+ printf1 ("heapSym = %d\n", heapSym)
+ END ;
+ IF heapSym # NulSym
+ THEN
+ SetVarInitialized (op3, FALSE) ;
+ ptr := getContent (getLAlias (op3)) ;
+ IF ptr # NulSym
+ THEN
+ SetupIndr (ptr, heapSym) ;
+ SetVarInitialized (ptr, FALSE)
+ END
+(*
+ vsym := getLAlias (op3) ;
+ VarInitState (vsym) ;
+ VarInitState (heapSym) ;
+ PutVarInitialized (vsym, GetMode (vsym)) ;
+ PutVarInitialized (heapSym, LeftValue) ;
+ SetupLAlias (vsym, heapSym)
+*)
+ END
+ END ;
+ DumpAliases
+END trashParam ;
+
+
+(*
+ SetVarLRInitialized -
+*)
+
+PROCEDURE SetVarLRInitialized (param: CARDINAL) ;
+VAR
+ sym: CARDINAL ;
+BEGIN
+ Assert (IsParameter (param)) ;
+ sym := GetParameterShadowVar (param) ;
+ IF sym # NulSym
+ THEN
+ IncludeItemIntoList (ignoreList, sym)
+ END
+END SetVarLRInitialized ;
+
+
(*
TestBBSequence -
*)
@@ -1381,20 +1583,26 @@ BEGIN
THEN
DumpBBSequence (procSym, lst)
END ;
- ForeachLocalSymDo (procSym, SetVarUninitialized) ;
initBlock ;
+ ForeachLocalSymDo (procSym, SetVarUninitialized) ;
+ ForeachParamSymDo (procSym, SetVarLRInitialized) ;
n := NoOfItemsInList (lst) ;
i := 1 ;
warning := TRUE ;
WHILE i <= n DO
bbi := GetItemFromList (lst, i) ;
bbPtr := Indexing.GetIndice (bbArray, bbi) ;
- CheckReadBeforeInitFirstBasicBlock (procSym, bbPtr^.start, bbPtr^.end, warning, lst, i) ;
+ CheckReadBeforeInitFirstBasicBlock (procSym,
+ bbPtr^.start, bbPtr^.end,
+ warning, lst, i) ;
IF bbPtr^.endCond
THEN
(* Check to see if we are moving into an conditional block in which case
we will issue a note. *)
warning := FALSE
+ ELSIF bbPtr^.endCall AND (bbPtr^.trashQuad # 0)
+ THEN
+ trashParam (bbPtr^.trashQuad)
END ;
INC (i)
END ;
@@ -1422,7 +1630,7 @@ BEGIN
ELSE
duplst := DuplicateList (lst) ;
IncludeItemIntoList (duplst, i) ;
- IF iPtr^.endCall
+ IF iPtr^.endCall AND (iPtr^.trashQuad = 0)
THEN
TestBBSequence (procSym, duplst)
ELSIF iPtr^.endGoto
@@ -1570,6 +1778,45 @@ BEGIN
END NewEntry ;
+(*
+ IsAllocate - return TRUE is sym is ALLOCATE.
+*)
+
+PROCEDURE IsAllocate (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsProcedure (sym) AND (GetSymName (sym) = MakeKey('ALLOCATE'))
+END IsAllocate ;
+
+
+(*
+ DetectTrash -
+*)
+
+PROCEDURE DetectTrash (bbPtr: bbEntry) ;
+VAR
+ i : CARDINAL ;
+ op : QuadOperator ;
+ op1, op2, op3: CARDINAL ;
+BEGIN
+ IF bbPtr^.endCall
+ THEN
+ i := bbPtr^.start ;
+ LOOP
+ GetQuad (i, op, op1, op2, op3) ;
+ IF (op = ParamOp) AND (op1 = 1) AND IsAllocate (op2)
+ THEN
+ bbPtr^.trashQuad := i
+ END ;
+ IF i = bbPtr^.end
+ THEN
+ RETURN
+ END ;
+ i := GetNextQuad (i)
+ END
+ END
+END DetectTrash ;
+
+
(*
AppendEntry -
*)
@@ -1589,6 +1836,7 @@ BEGIN
endGoto := IsGoto (End) ;
endCond := IsConditional (End) ;
topOfLoop := IsBackReference (Start) ;
+ trashQuad := 0 ;
indexBB := high + 1 ;
nextQuad := 0 ;
condQuad := 0 ;
@@ -1596,6 +1844,7 @@ BEGIN
condBB := 0 ;
next := NIL
END ;
+ DetectTrash (bbPtr) ;
Indexing.PutIndice (bbArray, high + 1, bbPtr)
END AppendEntry ;
@@ -1604,31 +1853,44 @@ END AppendEntry ;
DumpAlias -
*)
-PROCEDURE DumpAlias (aliasIndex: CARDINAL) ;
+PROCEDURE DumpAlias (array: Index; aliasIndex: CARDINAL) ;
VAR
sa: symAlias ;
BEGIN
- sa := Indexing.GetIndice (aliasArray, aliasIndex) ;
- printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias) ;
+ sa := Indexing.GetIndice (array, aliasIndex) ;
+ printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias)
END DumpAlias ;
(*
- DumpAliases -
+ doDumpAliases -
*)
-PROCEDURE DumpAliases ;
+PROCEDURE doDumpAliases (array: Index) ;
VAR
i, n: CARDINAL ;
+BEGIN
+ i := 1 ;
+ n := Indexing.HighIndice (array) ;
+ WHILE i <= n DO
+ DumpAlias (array, i) ;
+ INC (i)
+ END
+END doDumpAliases ;
+
+
+(*
+ DumpAliases -
+*)
+
+PROCEDURE DumpAliases ;
BEGIN
IF Debugging
THEN
- i := 1 ;
- n := Indexing.HighIndice (aliasArray) ;
- WHILE i <= n DO
- DumpAlias (i) ;
- INC (i)
- END
+ printf0 ("LArray\n") ;
+ doDumpAliases (LArray) ;
+ printf0 ("IndirectArray\n") ;
+ doDumpAliases (IndirectArray)
END
END DumpAliases ;
@@ -1687,7 +1949,9 @@ END killAlias ;
PROCEDURE initBlock ;
BEGIN
- aliasArray := Indexing.InitIndex (1) ;
+ LArray := Indexing.InitIndex (1) ;
+ IndirectArray := Indexing.InitIndex (1) ;
+ InitList (ignoreList)
END initBlock ;
@@ -1696,32 +1960,40 @@ END initBlock ;
*)
PROCEDURE killBlock ;
+BEGIN
+ doKillBlock (LArray) ;
+ doKillBlock (IndirectArray) ;
+ KillList (ignoreList)
+END killBlock ;
+
+
+PROCEDURE doKillBlock (VAR array: Index) ;
VAR
i, n: CARDINAL ;
BEGIN
i := 1 ;
- n := Indexing.HighIndice (aliasArray) ;
+ n := Indexing.HighIndice (array) ;
WHILE i <= n DO
- killAlias (Indexing.GetIndice (aliasArray, i)) ;
+ killAlias (Indexing.GetIndice (array, i)) ;
INC (i)
END ;
- aliasArray := Indexing.KillIndex (aliasArray)
-END killBlock ;
+ array := Indexing.KillIndex (array)
+END doKillBlock ;
(*
addAlias -
*)
-PROCEDURE addAlias (sym: CARDINAL; aliased: CARDINAL) ;
+PROCEDURE addAlias (array: Index; sym: CARDINAL; aliased: CARDINAL) ;
VAR
i, n: CARDINAL ;
sa : symAlias ;
BEGIN
i := 1 ;
- n := Indexing.HighIndice (aliasArray) ;
+ n := Indexing.HighIndice (array) ;
WHILE i <= n DO
- sa := Indexing.GetIndice (aliasArray, i) ;
+ sa := Indexing.GetIndice (array, i) ;
IF sa^.keySym = sym
THEN
sa^.alias := aliased ;
@@ -1730,7 +2002,7 @@ BEGIN
INC (i)
END ;
sa := initAlias (sym) ;
- Indexing.IncludeIndiceIntoIndex (aliasArray, sa) ;
+ Indexing.IncludeIndiceIntoIndex (array, sa) ;
sa^.alias := aliased
END addAlias ;
@@ -1739,15 +2011,15 @@ END addAlias ;
lookupAlias -
*)
-PROCEDURE lookupAlias (sym: CARDINAL) : symAlias ;
+PROCEDURE lookupAlias (array: Index; sym: CARDINAL) : symAlias ;
VAR
i, n: CARDINAL ;
sa : symAlias ;
BEGIN
i := 1 ;
- n := Indexing.HighIndice (aliasArray) ;
+ n := Indexing.HighIndice (array) ;
WHILE i <= n DO
- sa := Indexing.GetIndice (aliasArray, i) ;
+ sa := Indexing.GetIndice (array, i) ;
IF sa^.keySym = sym
THEN
RETURN sa
@@ -1762,11 +2034,11 @@ END lookupAlias ;
doGetAlias -
*)
-PROCEDURE doGetAlias (sym: CARDINAL) : CARDINAL ;
+PROCEDURE doGetAlias (array: Index; sym: CARDINAL) : CARDINAL ;
VAR
sa: symAlias ;
BEGIN
- sa := lookupAlias (sym) ;
+ sa := lookupAlias (array, sym) ;
IF (sa # NIL) AND (sa^.alias # NulSym)
THEN
RETURN sa^.alias
@@ -1776,10 +2048,10 @@ END doGetAlias ;
(*
- getAlias - attempts to looks up an alias which is not a temporary variable.
+ getLAlias - attempts to looks up an alias which is not a temporary variable.
*)
-PROCEDURE getAlias (sym: CARDINAL) : CARDINAL ;
+PROCEDURE getLAlias (sym: CARDINAL) : CARDINAL ;
VAR
type,
nsym: CARDINAL ;
@@ -1791,28 +2063,48 @@ BEGIN
IF (IsTemporary (sym) AND (GetMode (sym) = LeftValue)) OR
((type # NulSym) AND IsReallyPointer (type))
THEN
- nsym := doGetAlias (sym)
+ nsym := doGetAlias (LArray, sym)
ELSE
RETURN sym
END
UNTIL nsym = NulSym ;
RETURN sym
-END getAlias ;
+END getLAlias ;
(*
- SetupAlias -
+ SetupLAlias -
*)
-PROCEDURE SetupAlias (des, exp: CARDINAL) ;
+PROCEDURE SetupLAlias (des, exp: CARDINAL) ;
BEGIN
IF IsVar (exp) AND
((GetMode (des) = LeftValue) OR IsReallyPointer (GetSType (des)))
THEN
- addAlias (des, exp) ;
+ addAlias (LArray, des, exp) ;
DumpAliases
END
-END SetupAlias ;
+END SetupLAlias ;
+
+
+(*
+ SetupIndr -
+*)
+
+PROCEDURE SetupIndr (ptr, content: CARDINAL) ;
+BEGIN
+ addAlias (IndirectArray, ptr, content) ;
+END SetupIndr ;
+
+
+(*
+ getContent -
+*)
+
+PROCEDURE getContent (ptr: CARDINAL) : CARDINAL ;
+BEGIN
+ RETURN doGetAlias (IndirectArray, ptr)
+END getContent ;
(*
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 8c4feed7055..2cfa0d49ac9 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -92,6 +92,8 @@ EXPORT QUALIFIED NulSym,
ForeachModuleDo,
ForeachInnerModuleDo,
ForeachLocalSymDo,
+ ForeachParamSymDo,
+
ForeachFieldEnumerationDo,
GetModule,
GetCurrentModule,
@@ -204,6 +206,7 @@ EXPORT QUALIFIED NulSym,
PutVariableSSA, IsVariableSSA,
PutPublic, IsPublic, PutCtor, IsCtor, PutExtern, IsExtern,
PutMonoName, IsMonoName,
+ PutVarHeap, IsVarHeap,
IsDefImp,
IsModule,
@@ -694,6 +697,20 @@ PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL;
PROCEDURE PutModuleCtorExtern (tok: CARDINAL; sym: CARDINAL; external: BOOLEAN) ;
+(*
+ PutVarHeap - assigns ArrayRef field with value.
+*)
+
+PROCEDURE PutVarHeap (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsVarHeap - returns ArrayRef field value.
+*)
+
+PROCEDURE IsVarHeap (sym: CARDINAL) : BOOLEAN ;
+
+
(*
MakeVar - creates a variable sym with VarName. It returns the
symbol index.
@@ -2398,6 +2415,14 @@ PROCEDURE SanityCheckConstants ;
PROCEDURE ForeachLocalSymDo (Sym: CARDINAL; P: PerformOperation) ;
+(*
+ ForeachParamSymDo - foreach parameter symbol in procedure, Sym,
+ perform the procedure, P.
+*)
+
+PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ;
+
+
(*
ForeachFieldEnumerationDo - for each field in enumeration, Sym,
do procedure, P.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index df417fe8fdb..b5149a831f2 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -518,6 +518,7 @@ TYPE
IsConst : BOOLEAN ; (* Is variable read/only? *)
ArrayRef : BOOLEAN ; (* Is variable used to point *)
(* to an array? *)
+ Heap : BOOLEAN ; (* Is var on the heap? *)
InitState : LRInitDesc ; (* Initialization state. *)
At : Where ; (* Where was sym declared/used *)
ReadUsageList, (* list of var read quads *)
@@ -4254,6 +4255,7 @@ BEGIN
IsSSA := FALSE ;
IsConst := FALSE ;
ArrayRef := FALSE ;
+ Heap := FALSE ;
InitWhereDeclaredTok(tok, At) ;
InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
InitList(ReadUsageList[RightValue]) ;
@@ -6849,6 +6851,48 @@ BEGIN
END IsVarArrayRef ;
+(*
+ PutVarHeap - assigns ArrayRef field with value.
+*)
+
+PROCEDURE PutVarHeap (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: Var.Heap := value
+
+ ELSE
+ InternalError ('expecting VarSym')
+ END
+ END
+END PutVarHeap ;
+
+
+(*
+ IsVarHeap - returns ArrayRef field value.
+*)
+
+PROCEDURE IsVarHeap (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: RETURN (Var.Heap)
+
+ ELSE
+ InternalError ('expecting VarSym')
+ END
+ END
+END IsVarHeap ;
+
+
(*
PutFieldRecord - places a field, FieldName and FieldType into a record, Sym.
VarSym is a optional varient symbol which can be returned
@@ -8943,6 +8987,31 @@ BEGIN
END ForeachLocalSymDo ;
+(*
+ ForeachParamSymDo - foreach parameter symbol in procedure, Sym,
+ perform the procedure, P. Each symbol
+ looked up will be VarParam or Param
+ (not the shadow variable).
+*)
+
+PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ;
+VAR
+ param: CARDINAL ;
+ p, i : CARDINAL ;
+BEGIN
+ IF IsProcedure (Sym)
+ THEN
+ p := NoOfParam (Sym) ;
+ i := p ;
+ WHILE i>0 DO
+ param := GetNthParam (Sym, i) ;
+ P (param) ;
+ DEC(i)
+ END
+ END
+END ForeachParamSymDo ;
+
+
(*
CheckForUnknownInModule - checks for any unknown symbols in the
current module.
@@ -10016,31 +10085,31 @@ VAR
pSym : PtrToSymbol ;
VariableSym: CARDINAL ;
BEGIN
- VariableSym := MakeVar(tok, ParamName) ;
- pSym := GetPsym(VariableSym) ;
+ VariableSym := MakeVar (tok, ParamName) ;
+ pSym := GetPsym (VariableSym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym: RETURN( NulSym ) |
- VarSym : Var.IsParam := TRUE (* Variable is really a parameter *)
+ VarSym : Var.IsParam := TRUE (* Variable is really a parameter. *)
ELSE
InternalError ('expecting a Var symbol')
END
END ;
- (* Note that the parameter is now treated as a local variable *)
- PutVar(VariableSym, GetType(GetNthParam(ProcSym, no))) ;
- PutDeclared(tok, VariableSym) ;
+ (* Note that the parameter is now treated as a local variable. *)
+ PutVar (VariableSym, GetType(GetNthParam(ProcSym, no))) ;
+ PutDeclared (tok, VariableSym) ;
(*
Normal VAR parameters have LeftValue,
however Unbounded VAR parameters have RightValue.
Non VAR parameters always have RightValue.
*)
- IF IsVarParam(ProcSym, no) AND (NOT IsUnboundedParam(ProcSym, no))
+ IF IsVarParam (ProcSym, no) AND (NOT IsUnboundedParam (ProcSym, no))
THEN
- PutMode(VariableSym, LeftValue)
+ PutMode (VariableSym, LeftValue)
ELSE
- PutMode(VariableSym, RightValue)
+ PutMode (VariableSym, RightValue)
END ;
RETURN( VariableSym )
END MakeVariableForParam ;
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/assignparam.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/assignparam.mod
new file mode 100644
index 00000000000..9344ad0bb03
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/assignparam.mod
@@ -0,0 +1,31 @@
+MODULE assignparam ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test (p: PtrToVec) ;
+VAR
+ s: PtrToVec ;
+ v: Vec ;
+BEGIN
+ s := ADR (v) ;
+ s^ := p^ ;
+ IF s^.x = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ q: PtrToVec ;
+ w: Vec ;
+BEGIN
+ q := ADR (w) ;
+ test (q)
+END assignparam.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/tiny.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/tiny.mod
new file mode 100644
index 00000000000..668e09c03d3
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/tiny.mod
@@ -0,0 +1,13 @@
+MODULE tiny ;
+
+
+PROCEDURE test ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := 1
+END test ;
+
+BEGIN
+ test
+END tiny.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp
new file mode 100644
index 00000000000..6d22f36a6bd
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# 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_pim "${srcdir}/gm2/switches/uninit-variable-checking/procedures/fail" -Wuninit-variable-checking=all
+
+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-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod
new file mode 100644
index 00000000000..f0abe0a1312
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod
@@ -0,0 +1,31 @@
+MODULE testnew ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ ptr = POINTER TO RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test (p: ptr) ;
+BEGIN
+ NEW (p) ;
+ WITH p^ DO
+ a := 1 ;
+ (* user forgets to assign b. *)
+ IF b = 2
+ THEN
+ END
+ END
+END test ;
+
+
+VAR
+ n: ptr ;
+BEGIN
+ test (n)
+END testnew.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod
new file mode 100644
index 00000000000..4511302c98a
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod
@@ -0,0 +1,31 @@
+MODULE testnew2 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ ptr = POINTER TO RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: ptr ;
+BEGIN
+ NEW (p) ;
+ WITH p^ DO
+ a := 1 ;
+ (* user forgets to assign b. *)
+ IF b = 2
+ THEN
+ END
+ END
+END test ;
+
+
+BEGIN
+ test
+END testnew2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod
new file mode 100644
index 00000000000..bb8ceba884a
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod
@@ -0,0 +1,34 @@
+MODULE testnew3 ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ ptr = POINTER TO rec ;
+ rec = RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: ptr ;
+ r: rec ;
+BEGIN
+ p := ADR (r) ;
+ WITH p^ DO
+ a := 1 ;
+ (* user forgets to assign b. *)
+ IF b = 2
+ THEN
+ END
+ END
+END test ;
+
+
+BEGIN
+ test
+END testnew3.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod
new file mode 100644
index 00000000000..5c65ba8888c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod
@@ -0,0 +1,34 @@
+MODULE testnew4 ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ ptr = POINTER TO rec ;
+ rec = RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: ptr ;
+ r: rec ;
+BEGIN
+ p := ADR (r) ;
+ WITH p^ DO
+ a := 1 ;
+ (* user forgets to assign b. *)
+ IF b = 2
+ THEN
+ END
+ END
+END test ;
+
+
+BEGIN
+ test
+END testnew4.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod
new file mode 100644
index 00000000000..7cad3c222da
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod
@@ -0,0 +1,31 @@
+MODULE testnew5 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ ptr = POINTER TO RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test (p: ptr) ;
+BEGIN
+ NEW (p) ;
+ WITH p^ DO
+ a := 1 ;
+ (* user forgets to assign b. *)
+ IF b = 2
+ THEN
+ END
+ END
+END test ;
+
+
+VAR
+ n: ptr ;
+BEGIN
+ test (n)
+END testnew5.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod
new file mode 100644
index 00000000000..f77a8d8eb33
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod
@@ -0,0 +1,27 @@
+MODULE testnew6 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ PtrToVec = POINTER TO RECORD
+ x, y: INTEGER ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+BEGIN
+ NEW (p) ;
+ WITH p^ DO
+ x := 1 ;
+ x := 2 (* Deliberate typo, user meant y. *)
+ END ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testnew6.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod
new file mode 100644
index 00000000000..77503640e49
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod
@@ -0,0 +1,32 @@
+MODULE testptrptr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToPtrToVec = POINTER TO PtrToVec ;
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test ;
+VAR
+ vec: Vec ;
+ ptr: PtrToVec ;
+ ptrptr: PtrToPtrToVec ;
+BEGIN
+ ptr := ADR (vec) ;
+ ptrptr := ADR (ptr) ;
+ WITH ptrptr^^ DO
+ x := 1 ;
+ IF y = 2 (* error here. *)
+ THEN
+ END
+ END
+END test ;
+
+
+BEGIN
+ test
+END testptrptr.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod
new file mode 100644
index 00000000000..4a51efa0b47
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod
@@ -0,0 +1,31 @@
+MODULE assignparam2 ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test (p: PtrToVec) ;
+VAR
+ s: PtrToVec ;
+BEGIN
+ NEW (s) ;
+ s^ := p^ ;
+ IF s^.x = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ q: PtrToVec ;
+ w: Vec ;
+BEGIN
+ q := ADR (w) ;
+ test (q)
+END assignparam2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp
new file mode 100644
index 00000000000..ad1e971fd1b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# 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_pim "${srcdir}/gm2/switches/pedantic-params/procedures/pass" -Wuninit-variable-checking
+
+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/switches/uninit-variable-checking/procedures/pass/testnew5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew5.mod
new file mode 100644
index 00000000000..1cdca608394
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew5.mod
@@ -0,0 +1,27 @@
+MODULE testnew5 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ ptr = POINTER TO RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test (VAR p: ptr) ;
+BEGIN
+ NEW (p) ;
+ WITH p^ DO
+ a := 1 ;
+ END
+END test ;
+
+
+VAR
+ n: ptr ;
+BEGIN
+ test (n)
+END testnew5.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod
new file mode 100644
index 00000000000..b3a40188874
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod
@@ -0,0 +1,27 @@
+MODULE testnew6 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ ptr = POINTER TO RECORD
+ a, b: CARDINAL ;
+ END ;
+
+(*
+ test -
+*)
+
+PROCEDURE test (p: ptr) ;
+BEGIN
+ NEW (p) ;
+ WITH p^ DO
+ a := 1 ;
+ END
+END test ;
+
+
+VAR
+ n: ptr ;
+BEGIN
+ test (n)
+END testnew6.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod
new file mode 100644
index 00000000000..a783fbfcf2f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod
@@ -0,0 +1,26 @@
+MODULE testparamlvalue ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test (VAR p: PtrToVec) ;
+BEGIN
+ IF p^.x = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ q: PtrToVec ;
+ v: Vec ;
+BEGIN
+ q := ADR (v) ;
+ test (q)
+END testparamlvalue.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod
new file mode 100644
index 00000000000..eb9d0e92ad7
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod
@@ -0,0 +1,26 @@
+MODULE testparamrvalue ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test (p: PtrToVec) ;
+BEGIN
+ IF p^.x = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ q: PtrToVec ;
+ v: Vec ;
+BEGIN
+ q := ADR (v) ;
+ test (q)
+END testparamrvalue.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod
new file mode 100644
index 00000000000..647b2ff9d0e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod
@@ -0,0 +1,15 @@
+MODULE testproc ;
+
+
+PROCEDURE test (i: INTEGER) ;
+BEGIN
+ IF i = 3
+ THEN
+
+ END
+END test ;
+
+
+BEGIN
+ test (3)
+END testproc.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod
new file mode 100644
index 00000000000..f8c5b651034
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod
@@ -0,0 +1,29 @@
+MODULE testptrptr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToPtrToVec = POINTER TO PtrToVec ;
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test ;
+VAR
+ vec: Vec ;
+ ptr: PtrToVec ;
+ ptrptr: PtrToPtrToVec ;
+BEGIN
+ ptr := ADR (vec) ;
+ ptrptr := ADR (ptr) ;
+ WITH ptrptr^^ DO
+ x := 1
+ END
+END test ;
+
+
+BEGIN
+ test
+END testptrptr.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-07-30 10:01 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-30 10:01 [gcc r13-7652] modula2: Uninitialized variable static analysis improvements 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).