diff options
42 files changed, 2608 insertions, 202 deletions
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi index 3e531a8..ae87434 100644 --- a/gcc/doc/gm2.texi +++ b/gcc/doc/gm2.texi @@ -659,6 +659,11 @@ zero. @item -fwholevalue generate code to detect whole number overflow and underflow. +@item -Wuninit-variable-checking +issue a warning if a variable is used before it is initialized. +The checking only occurs in the first basic block in each procedure. +It does not check parameters, array types or set types. + @c the following warning options are complete but need to be @c regression tested against all other front ends @c to ensure the options do not conflict. @@ -1452,6 +1457,127 @@ with @samp{-fsoft-check-all} so that the compiler is able to run the optimizer and perform variable and flow analysis before the semantic 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. + +The following example detects whether a sub component within a record +is uninitialized. + +@example +MODULE testlarge2 ; + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.fg.r := 1 ; + p.fg.g := 2 ; + p.fg.g := 3 ; (* Deliberate typo should be p.fg.b. *) + p.bg := p.fg ; (* Accessing an uninitialized field. *) +END test ; + +BEGIN + test +END testlarge2. +@end example + +@example +$ gm2 -c -Wuninit-variable-checking testlarge2.mod +testlarge2.mod:19:13: warning: In procedure ‘test’: attempting to +access expression before it has been initialized + 19 | p.bg := p.fg ; (* Accessing an uninitialized field. *) + | ~^~~ +@end example + +The following example detects if an individual field is uninitialized. + +@example +MODULE testwithnoptr ; + +TYPE + Vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + p: Vec ; +BEGIN + WITH p DO + x := 1 ; + x := 2 (* Deliberate typo, user meant y. *) + END ; + IF p.y = 2 + THEN + END +END test ; + +BEGIN + test +END testwithnoptr. +@end example + +The following example detects a record is uninitialized via a +pointer variable in a @samp{WITH} block. + +@example +$ gm2 -g -c -Wuninit-variable-checking testwithnoptr.mod +testwithnoptr.mod:21:8: warning: In procedure ‘test’: attempting to +access expression before it has been initialized + 21 | IF p.y = 2 + | ~^~ +@end example + +@example +MODULE testwithptr ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + p: PtrToVec ; + v: Vec ; +BEGIN + p := ADR (v) ; + WITH p^ DO + x := 1 ; + x := 2 (* Deliberate typo, user meant y. *) + END ; + IF p^.y = 2 + THEN + END +END test ; + +BEGIN + test +END testwithptr. +@end example + +@example +gm2 -c -Wuninit-variable-checking testwithptr.mod +testwithptr.mod:26:9: warning: In procedure ‘test’: attempting to +access expression before it has been initialized + 26 | IF p^.y = 2 + | ~~^~ +@end example + @node Extensions, Type compatibility, Semantic checking, Using @section GNU Modula-2 language extensions diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index f6f7b48..6fb551f 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -462,7 +462,7 @@ GM2_G=-g -fm2-g GM2_CPP= # GM2_DEBUG_STRMEM=-fcpp GM2_DEBUG_STRMEM= -GM2_FLAGS=-Wunused-variable -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 \ @@ -750,6 +750,7 @@ GM2-COMP-BOOT-DEFS = \ M2StackWord.def \ M2Students.def \ M2Swig.def \ + M2SymInit.def \ M2System.def \ NameKey.def \ ObjectFiles.def \ @@ -822,6 +823,7 @@ GM2-COMP-BOOT-MODS = \ M2StackWord.mod \ M2Students.mod \ M2Swig.mod \ + M2SymInit.mod \ M2System.mod \ NameKey.mod \ NameKey.mod \ @@ -1027,6 +1029,7 @@ GM2-COMP-DEFS = \ M2StackWord.def \ M2Students.def \ M2Swig.def \ + M2SymInit.def \ M2System.def \ NameKey.def \ ObjectFiles.def \ @@ -1096,6 +1099,7 @@ GM2-COMP-MODS = \ M2StackWord.mod \ M2Students.mod \ M2Swig.mod \ + M2SymInit.mod \ M2System.mod \ NameKey.mod \ ObjectFiles.mod \ diff --git a/gcc/m2/gm2-compiler/M2BasicBlock.mod b/gcc/m2/gm2-compiler/M2BasicBlock.mod index 61eb613..1d005f6 100644 --- a/gcc/m2/gm2-compiler/M2BasicBlock.mod +++ b/gcc/m2/gm2-compiler/M2BasicBlock.mod @@ -242,7 +242,7 @@ BEGIN b := bb ; REPEAT WITH b^ DO - p(StartQuad, EndQuad) + p (StartQuad, EndQuad) END ; b := b^.Right UNTIL b=bb diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod index 6965b44..c4069e9 100644 --- a/gcc/m2/gm2-compiler/M2Code.mod +++ b/gcc/m2/gm2-compiler/M2Code.mod @@ -42,9 +42,11 @@ FROM NameKey IMPORT Name ; FROM M2Batch IMPORT ForeachSourceModuleDo ; FROM M2Quads IMPORT CountQuads, GetFirstQuad, DisplayQuadList, DisplayQuadRange, - BackPatchSubrangesAndOptParam, VariableAnalysis, + BackPatchSubrangesAndOptParam, LoopAnalysis, ForLoopAnalysis, GetQuad, QuadOperator ; +FROM M2SymInit IMPORT VariableAnalysis ; + FROM M2Pass IMPORT SetPassToNoPass, SetPassToCodeGeneration ; FROM M2BasicBlock IMPORT BasicBlock, diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index 5c171f7..c502726 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -120,7 +120,7 @@ FROM SymbolTable IMPORT NulSym, ForeachLocalSymDo, ForeachFieldEnumerationDo, ForeachProcedureDo, ForeachModuleDo, ForeachInnerModuleDo, ForeachImportedDo, - ForeachExportedDo ; + ForeachExportedDo, PrintInitialized ; FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction, GetBaseTypeMinMax, MixTypes, @@ -339,7 +339,6 @@ END DebugSetNumbers ; lists. *) -(* PROCEDURE AddSymToWatch (sym: WORD) ; BEGIN IF (sym#NulSym) AND (NOT IsElementInSet(WatchList, sym)) @@ -350,7 +349,6 @@ BEGIN FIO.FlushBuffer(FIO.StdOut) END END AddSymToWatch ; -*) (* @@ -409,7 +407,7 @@ BEGIN tobesolvedbyquads : doInclude(ToBeSolvedByQuads, "symbol %d -> ToBeSolvedByQuads\n", sym) | fullydeclared : doInclude(FullyDeclared, "symbol %d -> FullyDeclared\n", sym) ; - IF sym=1265 + IF sym=8821 THEN mystop END | @@ -2797,7 +2795,7 @@ PROCEDURE StartDeclareScope (scope: CARDINAL) ; VAR n: Name ; BEGIN - (* AddSymToWatch (1265) ; *) + (* AddSymToWatch (8821) ; *) (* AddSymToWatch (1157) ; *) (* watch goes here *) (* AddSymToWatch(TryFindSymbol('IOLink', 'DeviceId')) ; *) (* AddSymToWatch(819) ; *) @@ -3911,6 +3909,8 @@ BEGIN THEN printf0('component ') END ; + printf0 ('\n') ; + PrintInitialized (sym) ; IncludeType(l, sym) ELSIF IsConst(sym) THEN @@ -5229,16 +5229,7 @@ BEGIN t := CheckAlignment(t, sym) END END ; - IF GetSymName(sym)#NulName - THEN - IF Debugging - THEN - n := GetSymName(sym) ; - printf1('declaring type %a\n', n) - END ; - t := RememberType(t) - END ; - RETURN( t ) + RETURN RememberType (t) END TypeConstFullyDeclared ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index 90e237d..8b877e2 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -1842,13 +1842,14 @@ END CodeProcedureScope ; PROCEDURE CodeReturnValue (quad: CARDINAL) ; VAR op : QuadOperator ; + overflowChecking : BOOLEAN ; expr, none, procedure : CARDINAL ; combinedpos, returnpos, exprpos, nonepos, procpos: CARDINAL ; value, length : Tree ; location : location_t ; BEGIN - GetQuadOtok (quad, returnpos, op, expr, none, procedure, + GetQuadOtok (quad, returnpos, op, expr, none, procedure, overflowChecking, exprpos, nonepos, procpos) ; combinedpos := MakeVirtualTok (returnpos, returnpos, exprpos) ; location := TokenToLocation (combinedpos) ; @@ -3079,18 +3080,19 @@ END checkDeclare ; PROCEDURE CodeBecomes (quad: CARDINAL) ; VAR - op : QuadOperator ; - op1, op2, - op3 : CARDINAL ; + overflowChecking: BOOLEAN ; + op : QuadOperator ; + op1, op2, op3 : CARDINAL ; becomespos, op1pos, op2pos, - op3pos : CARDINAL ; + op3pos : CARDINAL ; length, - op3t : Tree ; - location : location_t ; + op3t : Tree ; + location : location_t ; BEGIN - GetQuadOtok (quad, becomespos, op, op1, op2, op3, op1pos, op2pos, op3pos) ; + GetQuadOtok (quad, becomespos, op, op1, op2, op3, overflowChecking, + op1pos, op2pos, op3pos) ; Assert (op2pos = UnknownTokenNo) ; DeclareConstant (CurrentQuadToken, op3) ; (* Check to see whether op3 is a constant and declare it. *) DeclareConstructor (CurrentQuadToken, quad, op3) ; @@ -7177,7 +7179,8 @@ END CodeIndrX ; PROCEDURE CodeXIndr (quad: CARDINAL) ; VAR - op : QuadOperator ; + overflowChecking: BOOLEAN ; + op : QuadOperator ; tokenno, op1, type, @@ -7185,12 +7188,13 @@ VAR op1pos, op3pos, typepos, - xindrpos: CARDINAL ; + xindrpos : CARDINAL ; length, - newstr : Tree ; - location: location_t ; + newstr : Tree ; + location : location_t ; BEGIN - GetQuadOtok (quad, xindrpos, op, op1, type, op3, op1pos, typepos, op3pos) ; + GetQuadOtok (quad, xindrpos, op, op1, type, op3, overflowChecking, + op1pos, typepos, op3pos) ; tokenno := MakeVirtualTok (xindrpos, op1pos, op3pos) ; location := TokenToLocation (tokenno) ; diff --git a/gcc/m2/gm2-compiler/M2Optimize.mod b/gcc/m2/gm2-compiler/M2Optimize.mod index ca03092..416eb42 100644 --- a/gcc/m2/gm2-compiler/M2Optimize.mod +++ b/gcc/m2/gm2-compiler/M2Optimize.mod @@ -58,8 +58,7 @@ FROM SymbolTable IMPORT GetSymName, FROM M2Quads IMPORT QuadOperator, GetQuad, GetFirstQuad, GetNextQuad, PutQuad, SubQuad, Opposite, IsReferenced, - GetRealQuad ; - + GetRealQuad, GetQuadOtok, PutQuadOtok ; (* FoldBranches - folds unneccessary branches in the list of quadruples. @@ -114,14 +113,14 @@ BEGIN GetQuad(i, Operator, Operand1, Operand2, Operand3) ; CASE Operator OF - GotoOp : Folded := ReduceGoto(i, Operand3, - Right, Folded) | + GotoOp : Folded := ReduceGoto (i, Operand3, + Right, Folded) | IfInOp, IfNotInOp, IfNotEquOp, IfEquOp, IfLessEquOp, IfGreEquOp, - IfGreOp, IfLessOp : Folded := ReduceBranch(Operator, i, - Operand1, Operand2, Operand3, - Right, Folded) + IfGreOp, IfLessOp : Folded := ReduceBranch (Operator, i, + Operand1, Operand2, Operand3, + Right, Folded) ELSE END ; @@ -154,48 +153,56 @@ PROCEDURE ReduceBranch (Operator: QuadOperator; VAR NextQuad: CARDINAL; Folded: BOOLEAN) : BOOLEAN ; VAR - OpNext : QuadOperator ; + overflowChecking: BOOLEAN ; + OpNext : QuadOperator ; + tok, NextPlusOne, Op1Next, Op2Next, Op3Next, - From, - To : CARDINAL ; + op1tok, + op2tok, + op3tok, + From, To : CARDINAL ; BEGIN (* If op NextQuad+1 *) (* Goto x *) IF NextQuad#0 THEN - IF (GetNextQuad(CurrentQuad)=CurrentOperand3) OR - (GetRealQuad(GetNextQuad(CurrentQuad))=CurrentOperand3) + IF (GetNextQuad (CurrentQuad) = CurrentOperand3) OR + (GetRealQuad (GetNextQuad (CurrentQuad)) = CurrentOperand3) THEN - SubQuad(CurrentQuad) ; + SubQuad (CurrentQuad) ; Folded := TRUE ELSE - From := GetNextQuad(CurrentQuad) ; (* start after CurrentQuad *) + From := GetNextQuad (CurrentQuad) ; (* start after CurrentQuad *) To := NextQuad ; - CurrentOperand3 := GetRealQuad(CurrentOperand3) ; + CurrentOperand3 := GetRealQuad (CurrentOperand3) ; - NextPlusOne := GetRealQuad(GetNextQuad(NextQuad)) ; - GetQuad(NextQuad, OpNext, Op1Next, Op2Next, Op3Next) ; - IF (OpNext=GotoOp) AND (NextPlusOne=CurrentOperand3) AND - IsBasicBlock(From, To) + NextPlusOne := GetRealQuad (GetNextQuad (NextQuad)) ; + GetQuad (NextQuad, OpNext, Op1Next, Op2Next, Op3Next) ; + IF (OpNext = GotoOp) AND (NextPlusOne = CurrentOperand3) AND + IsBasicBlock (From, To) THEN - (* Op3Next := GetRealQuad(Op3Next) ; *) - SubQuad(NextQuad) ; - PutQuad(CurrentQuad, Opposite(Operator), - CurrentOperand1, CurrentOperand2, Op3Next) ; + GetQuadOtok (CurrentQuad, tok, Operator, + CurrentOperand1, CurrentOperand2, CurrentOperand3, + overflowChecking, op1tok, op2tok, op3tok) ; + SubQuad (NextQuad) ; + PutQuadOtok (CurrentQuad, tok, Opposite (Operator), + CurrentOperand1, CurrentOperand2, Op3Next, + overflowChecking, + op1tok, op2tok, op3tok) ; NextQuad := NextPlusOne ; Folded := TRUE END END ; - IF FoldMultipleGoto(CurrentQuad) + IF FoldMultipleGoto (CurrentQuad) THEN Folded := TRUE END END ; - RETURN( Folded ) + RETURN Folded END ReduceBranch ; @@ -237,20 +244,20 @@ END IsBasicBlock ; PROCEDURE ReduceGoto (CurrentQuad, CurrentOperand3, NextQuad: CARDINAL; Folded: BOOLEAN) : BOOLEAN ; BEGIN - CurrentOperand3 := GetRealQuad(CurrentOperand3) ; + CurrentOperand3 := GetRealQuad (CurrentOperand3) ; (* IF next quad is a GotoOp *) - IF CurrentOperand3=NextQuad + IF CurrentOperand3 = NextQuad THEN - SubQuad(CurrentQuad) ; + SubQuad (CurrentQuad) ; Folded := TRUE ELSE (* Does Goto point to another Goto ? *) - IF FoldMultipleGoto(CurrentQuad) + IF FoldMultipleGoto (CurrentQuad) THEN Folded := TRUE END END ; - RETURN( Folded ) + RETURN Folded END ReduceGoto ; @@ -272,18 +279,18 @@ VAR Operand2, Operand3: CARDINAL ; BEGIN - GetQuad(QuadNo, Operator, Operand1, Operand2, Operand3) ; - Operand3 := GetRealQuad(Operand3) ; (* skip pseudo quadruples *) - GetQuad(Operand3, Op, Op1, Op2, Op3) ; - IF Op=GotoOp + GetQuad (QuadNo, Operator, Operand1, Operand2, Operand3) ; + Operand3 := GetRealQuad (Operand3) ; (* skip pseudo quadruples *) + GetQuad (Operand3, Op, Op1, Op2, Op3) ; + IF Op = GotoOp THEN - PutQuad(QuadNo, Operator, Operand1, Operand2, Op3) ; + PutQuad (QuadNo, Operator, Operand1, Operand2, Op3) ; (* Dont want success to be returned if in fact the Goto *) (* line number has not changed... otherwise we loop *) (* forever. *) - RETURN( Op3#Operand3 ) + RETURN Op3 # Operand3 ELSE - RETURN( FALSE ) + RETURN FALSE END END FoldMultipleGoto ; @@ -352,29 +359,29 @@ BEGIN IF Start#0 THEN REPEAT - GetQuad(Start, Op, Op1, Op2, Op3) ; + GetQuad (Start, Op, Op1, Op2, Op3) ; CASE Op OF - CallOp : KnownReach(Op3) | + CallOp : KnownReach (Op3) | AddrOp, ParamOp, XIndrOp, - BecomesOp: KnownReach(Op3) ; - CheckNeedSavePriority(Op3) + BecomesOp: KnownReach (Op3) ; + CheckNeedSavePriority (Op3) ELSE END ; - Start := GetNextQuad(Start) - UNTIL (Start>End) OR (Start=0) + Start := GetNextQuad (Start) + UNTIL (Start > End) OR (Start = 0) END END KnownReachable ; PROCEDURE KnownReach (sym: CARDINAL) ; BEGIN - IF IsProcedure(sym) AND (NOT IsProcedureReachable(sym)) + IF IsProcedure (sym) AND (NOT IsProcedureReachable (sym)) THEN - RemoveProcedures(sym) + RemoveProcedures (sym) END END KnownReach ; diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def index 7e4d2aa..722e56c 100644 --- a/gcc/m2/gm2-compiler/M2Options.def +++ b/gcc/m2/gm2-compiler/M2Options.def @@ -72,6 +72,7 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck, AutoInit, VariantValueChecking, UnusedVariableChecking, UnusedParameterChecking, + UninitVariableChecking, SetUninitVariableChecking, SetUnusedVariableChecking, SetUnusedParameterChecking, Quiet, LineDirectives, StrictTypeChecking, CPreProcessor, Xcode, ExtendedOpaque, @@ -159,6 +160,8 @@ VAR Exceptions, (* Should we generate exception code? *) UnusedVariableChecking, (* Should we warn about unused variables? *) UnusedParameterChecking, (* Should we warn about unused parameters? *) + UninitVariableChecking, (* Should we warn about accessing *) + (* uninitialized variables in the first bb? *) LowerCaseKeywords, (* Should keywords in errors be in lower? *) DebugBuiltins, (* Should we always call a real function? *) AutoInit, (* -fauto-init assigns pointers to NIL. *) @@ -919,6 +922,13 @@ PROCEDURE SetShared (value: BOOLEAN) ; (* + SetUninitVariableChecking - sets the UninitVariableChecking flag to value. +*) + +PROCEDURE SetUninitVariableChecking (value: BOOLEAN) ; + + +(* FinaliseOptions - once all options have been parsed we set any inferred values. *) diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod index 7cacee2..84fcb57 100644 --- a/gcc/m2/gm2-compiler/M2Options.mod +++ b/gcc/m2/gm2-compiler/M2Options.mod @@ -1190,6 +1190,7 @@ PROCEDURE SetWall (value: BOOLEAN) ; BEGIN UnusedVariableChecking := value ; UnusedParameterChecking := value ; + UninitVariableChecking := value ; PedanticCast := value ; PedanticParamNames := value ; StyleChecking := value @@ -1226,6 +1227,7 @@ BEGIN RETURN SaveTempsDir END GetSaveTempsDir ; + (* SetDumpDir - Set the dump dir. *) @@ -1363,6 +1365,17 @@ BEGIN END SetShared ; +(* + SetUninitVariableChecking - sets the UninitVariableChecking flag to value. +*) + +PROCEDURE SetUninitVariableChecking (value: BOOLEAN) ; +BEGIN + UninitVariableChecking := value +END SetUninitVariableChecking ; + + + BEGIN cflag := FALSE ; (* -c. *) RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ; @@ -1433,6 +1446,7 @@ BEGIN MQarg := NIL ; SaveTempsDir := NIL ; DumpDir := NIL ; + UninitVariableChecking := FALSE ; M2Prefix := InitString ('') ; M2PathName := InitString ('') END M2Options. diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index fcb59bb..ef6c06c 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -129,13 +129,13 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile, GetQuad, GetFirstQuad, GetNextQuad, PutQuad, SubQuad, EraseQuad, GetRealQuad, - GetQuadtok, GetQuadOtok, + GetQuadtok, GetQuadOtok, PutQuadOtok, GetQuadOp, GetM2OperatorDesc, CountQuads, GetLastFileQuad, GetLastQuadNo, QuadToLineNo, QuadToTokenNo, - VariableAnalysis, LoopAnalysis, ForLoopAnalysis, + LoopAnalysis, ForLoopAnalysis, AddVarientFieldToList, AddRecordToList, AddVarientToList, AddVarientRange, AddVarientEquality, @@ -477,10 +477,24 @@ PROCEDURE GetQuadOtok (QuadNo: CARDINAL; VAR tok: CARDINAL; VAR Op: QuadOperator; VAR Oper1, Oper2, Oper3: CARDINAL; + VAR overflowChecking: BOOLEAN ; VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ; (* + PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and + sets a boolean to determinine whether overflow should be checked. +*) + +PROCEDURE PutQuadOtok (QuadNo: CARDINAL; + tok: CARDINAL; + Op: QuadOperator; + Oper1, Oper2, Oper3: CARDINAL; + overflowChecking: BOOLEAN ; + Op1Pos, Op2Pos, Op3Pos: CARDINAL) ; + + +(* PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3 *) @@ -2574,16 +2588,6 @@ PROCEDURE BuildStmtNote (offset: INTEGER) ; (* - VariableAnalysis - checks to see whether a variable is: - - read without being initialized or - written over when it is a non var parameter -*) - -PROCEDURE VariableAnalysis (Start, End: CARDINAL) ; - - -(* LoopAnalysis - checks whether an infinite loop exists. *) diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index a27c3e1..dc73265 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -109,7 +109,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, PutConstructor, PutConstructorFrom, PutDeclared, MakeComponentRecord, MakeComponentRef, - IsSubscript, + IsSubscript, IsComponent, IsTemporary, IsAModula2Type, PutLeftValueFrontBackType, @@ -210,6 +210,7 @@ FROM M2Options IMPORT NilChecking, Pedantic, CompilerDebugging, GenerateDebugging, GenerateLineDebug, Exceptions, Profiling, Coding, Optimizing, + UninitVariableChecking, ScaffoldDynamic, ScaffoldStatic, cflag, ScaffoldMain, SharedFlag, WholeProgram, GetRuntimeModuleOverride ; @@ -262,15 +263,14 @@ IMPORT M2Error ; CONST DebugStackOn = TRUE ; DebugVarients = FALSE ; - BreakAtQuad = 133 ; + BreakAtQuad = 53 ; DebugTokPos = FALSE ; TYPE - ConstructorFrame = POINTER TO constructorFrame ; - constructorFrame = RECORD - type : CARDINAL ; - index: CARDINAL ; - END ; + ConstructorFrame = POINTER TO RECORD + type : CARDINAL ; + index: CARDINAL ; + END ; BoolFrame = POINTER TO RECORD TrueExit : CARDINAL ; @@ -1127,7 +1127,7 @@ PROCEDURE GetQuadtok (QuadNo: CARDINAL; VAR f: QuadFrame ; BEGIN - f := GetQF(QuadNo) ; + f := GetQF (QuadNo) ; LastQuadNo := QuadNo ; WITH f^ DO Op := Operator ; @@ -1149,11 +1149,12 @@ PROCEDURE GetQuadOtok (QuadNo: CARDINAL; VAR tok: CARDINAL; VAR Op: QuadOperator; VAR Oper1, Oper2, Oper3: CARDINAL; + VAR overflowChecking: BOOLEAN ; VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ; VAR f: QuadFrame ; BEGIN - f := GetQF(QuadNo) ; + f := GetQF (QuadNo) ; LastQuadNo := QuadNo ; WITH f^ DO Op := Operator ; @@ -1163,12 +1164,51 @@ BEGIN Op1Pos := op1pos ; Op2Pos := op2pos ; Op3Pos := op3pos ; - tok := TokenNo + tok := TokenNo ; + overflowChecking := CheckOverflow END END GetQuadOtok ; (* + PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and + sets a boolean to determinine whether overflow should be checked. +*) + +PROCEDURE PutQuadOtok (QuadNo: CARDINAL; + tok: CARDINAL; + Op: QuadOperator; + Oper1, Oper2, Oper3: CARDINAL; + overflowChecking: BOOLEAN ; + Op1Pos, Op2Pos, Op3Pos: CARDINAL) ; +VAR + f: QuadFrame ; +BEGIN + IF QuadNo = BreakAtQuad + THEN + stop + END ; + IF QuadrupleGeneration + THEN + EraseQuad (QuadNo) ; + AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3) ; + f := GetQF (QuadNo) ; + WITH f^ DO + Operator := Op ; + Operand1 := Oper1 ; + Operand2 := Oper2 ; + Operand3 := Oper3 ; + CheckOverflow := overflowChecking ; + op1pos := Op1Pos ; + op2pos := Op2Pos ; + op3pos := Op3Pos ; + TokenNo := tok + END + END +END PutQuadOtok ; + + +(* AddQuadInformation - adds variable analysis and jump analysis to the new quadruple. *) @@ -3118,7 +3158,7 @@ PROCEDURE MarkArrayWritten (Array: CARDINAL) ; BEGIN IF (Array#NulSym) AND IsVarAParam(Array) THEN - PutVarWritten(Array, TRUE) + PutVarWritten (Array, TRUE) END END MarkArrayWritten ; @@ -3157,9 +3197,9 @@ END MarkAsRead ; PROCEDURE MarkAsWrite (sym: CARDINAL) ; BEGIN - IF (sym#NulSym) AND IsVar(sym) + IF (sym # NulSym) AND IsVar (sym) THEN - PutWriteQuad(sym, RightValue, NextQuad) + PutWriteQuad (sym, RightValue, NextQuad) END END MarkAsWrite ; @@ -3171,14 +3211,14 @@ END MarkAsWrite ; PROCEDURE doVal (type, expr: CARDINAL) : CARDINAL ; BEGIN - IF (NOT IsConst(expr)) AND (SkipType(type)#GetDType(expr)) + IF (NOT IsConst (expr)) AND (SkipType (type) # GetDType (expr)) THEN - PushTF(Convert, NulSym) ; - PushT(SkipType(type)) ; - PushT(expr) ; - PushT(2) ; (* Two parameters *) + PushTF (Convert, NulSym) ; + PushT (SkipType(type)) ; + PushT (expr) ; + PushT (2) ; (* Two parameters *) BuildConvertFunction ; - PopT(expr) + PopT (expr) END ; RETURN( expr ) END doVal ; @@ -5952,12 +5992,15 @@ VAR BEGIN IF GetDType(des)=GetDType(exp) THEN - GenQuadO (tok, IndrXOp, des, GetSType(des), exp, TRUE) + GenQuadOtok (tok, IndrXOp, des, GetSType (des), exp, TRUE, + tok, tok, tok) ELSE t := MakeTemporary (tok, RightValue) ; PutVar (t, GetSType (exp)) ; - GenQuadO (tok, IndrXOp, t, GetSType (exp), exp, TRUE) ; - GenQuadO (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE) + GenQuadOtok (tok, IndrXOp, t, GetSType (exp), exp, TRUE, + tok, tok, tok) ; + GenQuadOtok (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE, + tok, UnknownTokenNo, tok) END END doIndrX ; @@ -5986,7 +6029,8 @@ BEGIN *) t := MakeTemporary (tok, RightValue) ; PutVar (t, type) ; - GenQuadO (tok, BecomesOp, t, NulSym, doVal(type, Sym), TRUE) ; + GenQuadOtok (tok, BecomesOp, t, NulSym, doVal (type, Sym), TRUE, + tok, tok, tok) ; RETURN t END ELSE @@ -6022,13 +6066,15 @@ BEGIN *) t := MakeTemporary (tok, with) ; PutVar (t, type) ; - GenQuadO (tok, BecomesOp, t, NulSym, Sym, TRUE) ; + GenQuadOtok (tok, BecomesOp, t, NulSym, Sym, TRUE, + tok, UnknownTokenNo, tok) ; RETURN t END ELSE t := MakeTemporary (tok, with) ; PutVar (t, type) ; - GenQuadO (tok, AddrOp, t, NulSym, Sym, TRUE) ; + GenQuadOtok (tok, AddrOp, t, NulSym, Sym, TRUE, + tok, UnknownTokenNo, tok) ; RETURN t END END MakeLeftValue ; @@ -6998,13 +7044,13 @@ BEGIN IF IsExpressionCompatible (dtype, etype) THEN (* the easy case simulate a straightforward macro *) - PushTF(des, dtype) ; - PushT(tok) ; - PushTF(expr, etype) ; - doBuildBinaryOp(FALSE, TRUE) + PushTF (des, dtype) ; + PushT (tok) ; + PushTF (expr, etype) ; + doBuildBinaryOp (FALSE, TRUE) ELSE - IF (IsOrdinalType(dtype) OR (dtype=Address) OR IsPointer(dtype)) AND - (IsOrdinalType(etype) OR (etype=Address) OR IsPointer(etype)) + IF (IsOrdinalType (dtype) OR (dtype = Address) OR IsPointer (dtype)) AND + (IsOrdinalType (etype) OR (etype = Address) OR IsPointer (etype)) THEN PushTF (des, dtype) ; PushT (tok) ; @@ -10502,72 +10548,6 @@ END BuildProcedureEnd ; (* - CheckReadBeforeInitialized - -*) - -PROCEDURE CheckReadBeforeInitialized (ProcSym: CARDINAL; End: CARDINAL) ; -VAR - s1, s2 : String ; - i, n, ParamNo, - ReadStart, ReadEnd, - WriteStart, WriteEnd: CARDINAL ; -BEGIN - ParamNo := NoOfParam(ProcSym) ; - i := 1 ; - REPEAT - n := GetNth(ProcSym, i) ; - IF (n#NulSym) AND (NOT IsTemporary(n)) - THEN - GetReadQuads(n, RightValue, ReadStart, ReadEnd) ; - GetWriteQuads(n, RightValue, WriteStart, WriteEnd) ; - IF i>ParamNo - THEN - (* n is a not a parameter thus we can check *) - IF (ReadStart>0) AND (ReadStart<End) - THEN - (* it is read in the first basic block *) - IF ReadStart<WriteStart - THEN - (* read before written, this is a problem which must be fixed *) - s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(n)))) ; - s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcSym)))) ; - ErrorStringAt2(Sprintf2(Mark(InitString('reading from a variable (%s) before it is initialized in procedure (%s)')), - s1, s2), - GetDeclaredMod(n), GetDeclaredMod(n)) - END - END - END - END ; - INC(i) - UNTIL n=NulSym -END CheckReadBeforeInitialized ; - - -(* - VariableAnalysis - checks to see whether a variable is: - - read before it has been initialized -*) - -PROCEDURE VariableAnalysis (Start, End: CARDINAL) ; -VAR - Op : QuadOperator ; - Op1, Op2, Op3: CARDINAL ; -BEGIN - IF Pedantic - THEN - GetQuad(Start, Op, Op1, Op2, Op3) ; - CASE Op OF - - NewLocalVarOp: CheckReadBeforeInitialized(Op3, End) - - ELSE - END - END -END VariableAnalysis ; - - -(* IsNeverAltered - returns TRUE if variable, sym, is never altered between quadruples: Start..End *) @@ -10576,8 +10556,8 @@ PROCEDURE IsNeverAltered (sym: CARDINAL; Start, End: CARDINAL) : BOOLEAN ; VAR WriteStart, WriteEnd: CARDINAL ; BEGIN - GetWriteLimitQuads(sym, GetMode(sym), Start, End, WriteStart, WriteEnd) ; - RETURN( (WriteStart=0) AND (WriteEnd=0) ) + GetWriteLimitQuads (sym, GetMode (sym), Start, End, WriteStart, WriteEnd) ; + RETURN( (WriteStart = 0) AND (WriteEnd = 0) ) END IsNeverAltered ; @@ -10592,8 +10572,8 @@ VAR LeftFixed, RightFixed : BOOLEAN ; BEGIN - GetQuad(q, op, op1, op2, op3) ; - IF op=GotoOp + GetQuad (q, op, op1, op2, op3) ; + IF op = GotoOp THEN RETURN( FALSE ) ELSE @@ -10844,6 +10824,7 @@ END AsmStatementsInBlock ; PROCEDURE CheckVariablesInBlock (BlockSym: CARDINAL) ; BEGIN CheckVariablesAndParameterTypesInBlock (BlockSym) ; + (* IF UnusedVariableChecking OR UnusedParameterChecking THEN IF (NOT AsmStatementsInBlock (BlockSym)) @@ -10851,6 +10832,7 @@ BEGIN CheckUninitializedVariablesAreUsed (BlockSym) END END + *) END CheckVariablesInBlock ; @@ -11429,6 +11411,19 @@ END BuildDynamicArray ; (* + DebugLocation - +*) + +PROCEDURE DebugLocation (tok: CARDINAL; message: ARRAY OF CHAR) ; +BEGIN + IF DebugTokPos + THEN + WarnStringAt (InitString (message), tok) + END +END DebugLocation ; + + +(* BuildDesignatorPointer - Builds a pointer reference. The Stack is expected to contain: @@ -11451,6 +11446,8 @@ VAR Sym2, Type2: CARDINAL ; BEGIN PopTFrwtok (Sym1, Type1, rw, exprtok) ; + DebugLocation (exprtok, "expression") ; + Type1 := SkipType (Type1) ; IF Type1 = NulSym THEN @@ -11473,15 +11470,16 @@ BEGIN THEN rw := NulSym ; PutLeftValueFrontBackType (Sym2, Type2, Type1) ; - GenQuad (IndrXOp, Sym2, Type1, Sym1) (* Sym2 := *Sym1 *) + GenQuadO (ptrtok, IndrXOp, Sym2, Type1, Sym1, FALSE) (* Sym2 := *Sym1 *) ELSE PutLeftValueFrontBackType (Sym2, Type2, NulSym) ; - GenQuad (BecomesOp, Sym2, NulSym, Sym1) (* Sym2 := Sym1 *) + GenQuadO (ptrtok, BecomesOp, Sym2, NulSym, Sym1, FALSE) (* Sym2 := Sym1 *) END ; PutVarPointerCheck (Sym2, TRUE) ; (* we should check this for *) (* Sym2 later on (pointer via NIL) *) combinedtok := MakeVirtualTok (exprtok, exprtok, ptrtok) ; - PushTFrwtok (Sym2, Type2, rw, combinedtok) + PushTFrwtok (Sym2, Type2, rw, combinedtok) ; + DebugLocation (combinedtok, "pointer expression") ELSE MetaError2 ('{%1ad} is not a pointer type but a {%2d}', Sym1, Type1) END @@ -11505,23 +11503,26 @@ VAR Sym, Type, Ref : CARDINAL ; BEGIN + DebugLocation (withtok, "with") ; BuildStmtNoteTok (withTok) ; DisplayStack ; PopTFtok (Sym, Type, tok) ; + DebugLocation (tok, "expression") ; Type := SkipType (Type) ; Ref := MakeTemporary (tok, LeftValue) ; PutVar (Ref, Type) ; IF GetMode (Sym) = LeftValue THEN - (* copy LeftValue *) + (* Copy LeftValue. *) GenQuadO (tok, BecomesOp, Ref, NulSym, Sym, TRUE) ELSE - (* calculate the address of Sym *) + (* Calculate the address of Sym. *) GenQuadO (tok, AddrOp, Ref, NulSym, Sym, TRUE) END ; PushWith (Sym, Type, Ref, tok) ; + DebugLocation (tok, "with ref") ; IF Type = NulSym THEN MetaError1 ('{%1Ea} {%1d} has a no type, the {%kWITH} statement requires a variable or parameter of a {%kRECORD} type', @@ -11562,9 +11563,9 @@ BEGIN IF Pedantic THEN n := NoOfItemsInStackAddress(WithStack) ; - i := 1 ; (* top of the stack *) + i := 1 ; (* Top of the stack. *) WHILE i <= n DO - (* Search for other declarations of the with using Type *) + (* Search for other declarations of the with using Type. *) f := PeepAddress(WithStack, i) ; IF f^.RecordSym=Type THEN @@ -12454,7 +12455,7 @@ VAR leftpos, rightpos : CARDINAL ; value : CARDINAL ; BEGIN - Operator := OperandT(2) ; + Operator := OperandT (2) ; IF Operator = OrTok THEN CheckBooleanId ; @@ -12874,6 +12875,7 @@ VAR t, rightType, leftType, right, left : CARDINAL ; + s : String ; BEGIN IF CompilerDebugging THEN @@ -12926,7 +12928,23 @@ BEGIN left := t END ; combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ; - GenQuadO (combinedTok, MakeOp (Op), left, right, 0, FALSE) ; (* True Exit *) + + IF DebugTokPos + THEN + s := InitStringCharStar (KeyToCharStar (GetTokenName (Op))) ; + WarnStringAt (s, optokpos) ; + s := InitString ('left') ; + WarnStringAt (s, leftpos) ; + s := InitString ('right') ; + WarnStringAt (s, rightpos) ; + s := InitString ('caret') ; + WarnStringAt (s, optokpos) ; + s := InitString ('combined') ; + WarnStringAt (s, combinedTok) + END ; + + GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, FALSE, + leftpos, rightpos, UnknownTokenNo) ; (* True Exit *) GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *) PushBool (NextQuad-2, NextQuad-1) END diff --git a/gcc/m2/gm2-compiler/M2SymInit.def b/gcc/m2/gm2-compiler/M2SymInit.def new file mode 100644 index 0000000..2ea6bfc --- /dev/null +++ b/gcc/m2/gm2-compiler/M2SymInit.def @@ -0,0 +1,59 @@ +(* M2SymInit.def records initialization state for variables. + +Copyright (C) 2001-2023 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. + +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 3, 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 GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. *) + +DEFINITION MODULE M2SymInit ; + +FROM Lists IMPORT List ; + +TYPE + InitDesc ; + + +PROCEDURE InitSymInit () : InitDesc ; +PROCEDURE KillSymInit (VAR desc: InitDesc) ; + + +PROCEDURE ConfigSymInit (desc: InitDesc; sym: CARDINAL) ; + + +PROCEDURE SetInitialized (desc: InitDesc) ; +PROCEDURE GetInitialized (desc: InitDesc) : BOOLEAN ; + + +PROCEDURE GetFieldDesc (desc: InitDesc; field: CARDINAL) : InitDesc ; + +PROCEDURE SetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ; +PROCEDURE GetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ; + + +(* + VariableAnalysis - checks to see whether a variable is: + + read before it has been initialized +*) + +PROCEDURE VariableAnalysis (Start, End: CARDINAL) ; + + +PROCEDURE PrintSymInit (desc: InitDesc) ; + + +END M2SymInit. diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod new file mode 100644 index 0000000..18200af --- /dev/null +++ b/gcc/m2/gm2-compiler/M2SymInit.mod @@ -0,0 +1,1307 @@ +(* M2SymInit.mod records initialization state for variables. + +Copyright (C) 2001-2023 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. + +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 3, 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 GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. *) + +IMPLEMENTATION MODULE M2SymInit ; + +FROM Storage IMPORT ALLOCATE, DEALLOCATE ; +FROM M2Debug IMPORT Assert ; +FROM libc IMPORT printf ; +FROM NameKey IMPORT Name, NulName, KeyToCharStar ; +FROM M2Options IMPORT UninitVariableChecking ; +FROM M2MetaError IMPORT MetaErrorT1 ; +FROM M2LexBuf IMPORT UnknownTokenNo ; + +IMPORT Indexing ; + +FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList, + IsItemInList, IncludeItemIntoList, NoOfItemsInList, + RemoveItemFromList, ForeachItemInListDo, KillList ; + +FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType, + GetNth, IsRecordField, IsSet, IsArray, IsProcedure, + GetVarScope, IsVarAParam, IsComponent, GetMode, + VarCheckReadInit, VarInitState, PutVarInitialized, + PutVarFieldInitialized, GetVarFieldInitialized, + IsConst, IsConstString, NoOfParam, IsVarParam, + ForeachLocalSymDo, IsTemporary, ModeOfAddr, + IsReallyPointer, IsUnbounded, + IsVarient, IsFieldVarient, GetVarient ; + +FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad ; +FROM M2Options IMPORT CompilerDebugging ; +FROM M2Printf IMPORT printf0, printf1, printf2 ; +FROM M2GCCDeclare IMPORT PrintSym ; + + +CONST + Debugging = FALSE ; + +TYPE + descType = (scalar, record) ; + + InitDesc = POINTER TO RECORD + sym, type : CARDINAL ; + initialized: BOOLEAN ; + CASE kind: descType OF + + scalar: | + record: rec: recordDesc | + + END + END ; + + recordDesc = RECORD + fieldDesc: Indexing.Index ; + END ; + + symAlias = POINTER TO RECORD + keySym, + alias : CARDINAL ; + next : symAlias ; + END ; + +VAR + aliasArray: Indexing.Index ; + freeList : symAlias ; + + +(* + PrintSymInit - +*) + +PROCEDURE PrintSymInit (desc: InitDesc) ; +VAR + i, n: CARDINAL ; +BEGIN + printf ("sym %d: type %d ", desc^.sym, desc^.type) ; + IF desc^.kind = scalar + THEN + printf ("scalar") + ELSE + printf ("record") + END ; + IF NOT desc^.initialized + THEN + printf (" not") + END ; + printf (" initialized\n") ; + IF (desc^.type # NulSym) AND IsRecord (desc^.type) + THEN + i := 1 ; + n := Indexing.HighIndice (desc^.rec.fieldDesc) ; + WHILE i <= n DO + PrintSymInit (Indexing.GetIndice (desc^.rec.fieldDesc, i)) ; + INC (i) + END + END +END PrintSymInit ; + + +PROCEDURE InitSymInit () : InitDesc ; +VAR + id: InitDesc ; +BEGIN + NEW (id) ; + WITH id^ DO + sym := NulSym ; + type := NulSym ; + initialized := TRUE ; + kind := scalar + END ; + RETURN id +END InitSymInit ; + + +PROCEDURE KillSymInit (VAR desc: InitDesc) ; +BEGIN + WITH desc^ DO + CASE kind OF + + record: KillFieldDesc (rec.fieldDesc) + + ELSE + END + END ; + DISPOSE (desc) ; + desc := NIL +END KillSymInit ; + + +PROCEDURE ConfigSymInit (desc: InitDesc; sym: CARDINAL) ; +BEGIN + IF IsVar (sym) OR IsRecordField (sym) + THEN + desc^.sym := sym ; + desc^.type := GetSType (sym) ; + desc^.initialized := FALSE ; + IF IsRecord (desc^.type) + THEN + desc^.kind := record ; + desc^.rec.fieldDesc := Indexing.InitIndex (1) ; + PopulateFields (desc, desc^.type) + ELSE + desc^.kind := scalar ; + IF IsArray (desc^.type) + THEN + desc^.initialized := TRUE (* For now we don't attempt to handle array types. *) + END + END + END +END ConfigSymInit ; + + +(* + KillFieldDesc - +*) + +PROCEDURE KillFieldDesc (VAR fielddesc: Indexing.Index) ; +VAR + i, h: CARDINAL ; + id : InitDesc ; +BEGIN + i := 1 ; + h := Indexing.HighIndice (fielddesc) ; + WHILE i <= h DO + id := Indexing.GetIndice (fielddesc, i) ; + KillSymInit (id) ; + INC (i) + END ; + fielddesc := Indexing.KillIndex (fielddesc) +END KillFieldDesc ; + + +(* + PopulateFields - +*) + +PROCEDURE PopulateFields (desc: InitDesc; recsym: CARDINAL) ; +VAR + field, + i : CARDINAL ; + fdesc: InitDesc ; +BEGIN + Assert (IsRecord (recsym)) ; + i := 1 ; + REPEAT + field := GetNth (recsym, i) ; + IF field # NulSym + THEN + fdesc := InitSymInit () ; + ConfigSymInit (fdesc, field) ; + Indexing.IncludeIndiceIntoIndex (desc^.rec.fieldDesc, fdesc) ; + INC (i) + END + UNTIL field = NulSym +END PopulateFields ; + + +PROCEDURE SetInitialized (desc: InitDesc) ; +BEGIN + desc^.initialized := TRUE +END SetInitialized ; + + +PROCEDURE GetInitialized (desc: InitDesc) : BOOLEAN ; +BEGIN + IF NOT desc^.initialized + THEN + IF IsRecord (desc^.type) + THEN + TrySetInitialized (desc) + END + END ; + IF Debugging + THEN + PrintSymInit (desc) + END ; + RETURN desc^.initialized +END GetInitialized ; + + +PROCEDURE GetFieldDesc (desc: InitDesc; field: CARDINAL) : InitDesc ; +VAR + fsym, + i : CARDINAL ; +BEGIN + IF IsRecord (desc^.type) + THEN + i := 1 ; + REPEAT + fsym := GetNth (desc^.type, i) ; + IF field = fsym + THEN + RETURN Indexing.GetIndice (desc^.rec.fieldDesc, i) + END ; + INC (i) + UNTIL fsym = NulSym + END ; + RETURN NIL +END GetFieldDesc ; + + +PROCEDURE SetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ; +BEGIN + RETURN SetFieldInitializedNo (desc, fieldlist, 1) +END SetFieldInitialized ; + + +(* + TrySetInitialized - +*) + +PROCEDURE TrySetInitialized (desc: InitDesc) ; +VAR + i, h : CARDINAL ; + fdesc: InitDesc ; +BEGIN + h := Indexing.HighIndice (desc^.rec.fieldDesc) ; + i := 1 ; + WHILE i <= h DO + fdesc := Indexing.GetIndice (desc^.rec.fieldDesc, i) ; + IF NOT fdesc^.initialized + THEN + RETURN + END ; + INC (i) + END ; + desc^.initialized := TRUE +END TrySetInitialized ; + + +(* + SetFieldInitializedNo - +*) + +PROCEDURE SetFieldInitializedNo (desc: InitDesc; + fieldlist: List; level: CARDINAL) : BOOLEAN ; +VAR + init : BOOLEAN ; + nsym : CARDINAL ; + fdesc: InitDesc ; +BEGIN + IF level > NoOfItemsInList (fieldlist) + THEN + RETURN FALSE + ELSE + nsym := GetItemFromList (fieldlist, level) ; + fdesc := GetFieldDesc (desc, nsym) ; + IF fdesc = NIL + THEN + RETURN FALSE + ELSIF level = NoOfItemsInList (fieldlist) + THEN + SetInitialized (fdesc) ; + TrySetInitialized (desc) ; + RETURN desc^.initialized + ELSE + init := SetFieldInitializedNo (fdesc, fieldlist, level + 1) ; + TrySetInitialized (desc) ; + RETURN desc^.initialized + END + END +END SetFieldInitializedNo ; + + +PROCEDURE GetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ; +BEGIN + RETURN GetFieldInitializedNo (desc, fieldlist, 1) +END GetFieldInitialized ; + + +PROCEDURE GetFieldInitializedNo (desc: InitDesc; + fieldlist: List; level: CARDINAL) : BOOLEAN ; +VAR + nsym : CARDINAL ; + fdesc: InitDesc ; +BEGIN + IF desc^.initialized + THEN + RETURN TRUE + ELSIF level > NoOfItemsInList (fieldlist) + THEN + RETURN FALSE + ELSE + nsym := GetItemFromList (fieldlist, level) ; + fdesc := GetFieldDesc (desc, nsym) ; + IF fdesc = NIL + THEN + (* The pointer variable maybe uninitialized and hence we cannot + find the record variable. *) + RETURN FALSE + ELSIF fdesc^.initialized + THEN + RETURN TRUE + ELSE + RETURN GetFieldInitializedNo (fdesc, fieldlist, level + 1) + END + END +END GetFieldInitializedNo ; + + +(* + IsGlobalVar - +*) + +PROCEDURE IsGlobalVar (sym: CARDINAL) : BOOLEAN ; +BEGIN + RETURN IsVar (sym) AND (NOT IsProcedure (GetVarScope (sym))) +END IsGlobalVar ; + + +(* + IsLocalVar - +*) + +PROCEDURE IsLocalVar (procsym, varsym: CARDINAL) : BOOLEAN ; +BEGIN + RETURN IsVar (varsym) AND (GetVarScope (varsym) = procsym) +END IsLocalVar ; + + +(* + RecordFieldContainsVarient - +*) + +PROCEDURE RecordFieldContainsVarient (sym: CARDINAL) : BOOLEAN ; +BEGIN + Assert (IsRecordField (sym)) ; + IF ContainsVariant (GetSType (sym)) + THEN + RETURN TRUE + END ; + RETURN GetVarient (sym) # NulSym +END RecordFieldContainsVarient ; + + +(* + ContainsVariant - returns TRUE if type sym contains a variant record. +*) + +PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ; +VAR + i, + fieldsym, + fieldtype: CARDINAL ; +BEGIN + IF IsRecord (sym) + THEN + i := 1 ; + REPEAT + fieldsym := GetNth (sym, i) ; + IF fieldsym # NulSym + THEN + IF IsRecordField (fieldsym) + THEN + IF RecordFieldContainsVarient (fieldsym) + THEN + RETURN TRUE + END + ELSIF IsVarient (fieldsym) + THEN + RETURN TRUE + END ; + INC (i) + END + UNTIL fieldsym = NulSym + END ; + RETURN FALSE +END ContainsVariant ; + + +(* + CheckDeferredRecordAccess - +*) + +PROCEDURE CheckDeferredRecordAccess (procsym: CARDINAL; tok: CARDINAL; + sym: CARDINAL; canDereference: BOOLEAN) ; +BEGIN + IF IsVar (sym) + THEN + IF Debugging + THEN + Trace ("CheckDeferredRecordAccess %d\n", sym) ; + PrintSym (sym) ; + IF canDereference + THEN + printf1 ("checkReadInit (%d, true)\n", sym) + ELSE + printf1 ("checkReadInit (%d, false)\n", sym) + END + END ; + IF IsExempt (sym) + THEN + Trace ("checkReadInit sym is a parameter or not a local variable (%d)", sym) ; + (* We assume parameters have been initialized. *) + PutVarInitialized (sym, LeftValue) ; + PutVarInitialized (sym, RightValue) + (* SetVarInitialized (sym, TRUE) *) + ELSIF IsUnbounded (GetSType (sym)) + THEN + SetVarInitialized (sym, TRUE) + ELSIF IsComponent (sym) + THEN + Trace ("checkReadInit IsComponent (%d) is true)", sym) ; + IF NOT GetVarComponentInitialized (sym) + THEN + MetaErrorT1 (tok, + 'attempting to access {%1Wad} before it has been initialized', + sym) + END + ELSIF (GetMode (sym) = LeftValue) AND canDereference + THEN + Trace ("checkReadInit GetMode (%d) = LeftValue and canDereference (LeftValue and RightValue VarCheckReadInit)", sym) ; + IF NOT VarCheckReadInit (sym, LeftValue) + THEN + MetaErrorT1 (tok, + 'attempting to access the address of {%1Wad} before it has been initialized', + sym) + END ; + IF NOT VarCheckReadInit (sym, RightValue) + THEN + MetaErrorT1 (tok, + 'attempting to access {%1Wad} before it has been initialized', sym) + END + ELSE + Trace ("checkReadInit call VarCheckReadInit using GetMode (%d)", sym) ; + IF NOT VarCheckReadInit (sym, GetMode (sym)) + THEN + MetaErrorT1 (tok, + 'attempting to access {%1Wad} before it has been initialized', sym) + END + END + END +END CheckDeferredRecordAccess ; + + +(* + SetVarUninitialized - resets variable init state. +*) + +PROCEDURE SetVarUninitialized (sym: CARDINAL) ; +BEGIN + IF IsVar (sym) AND (NOT IsUnbounded (GetSType (sym))) AND (NOT IsVarAParam (sym)) + THEN + VarInitState (sym) + END +END SetVarUninitialized ; + + +(* + ComponentFindVar - +*) + +PROCEDURE ComponentFindVar (sym: CARDINAL) : CARDINAL ; +VAR + nsym, + i : CARDINAL ; +BEGIN + i := 1 ; + REPEAT + nsym := getAlias (GetNth (sym, i)) ; + IF (nsym # NulSym) AND IsVar (nsym) + THEN + IF (nsym # sym) AND IsComponent (nsym) + THEN + RETURN ComponentFindVar (nsym) + ELSE + RETURN nsym + END + END ; + INC (i) + UNTIL nsym = NulSym ; + RETURN NulSym +END ComponentFindVar ; + + +(* + ComponentCreateFieldList - builds a list of fields accessed by the component var. + Each item in the list will be a field of incremental levels + though a nested record. It is not a list of fields + at the same level. + + foo = RECORD + v: RECORD + x, y: CARDINAL ; + END ; + w: CARDINAL ; + END ; + + { v, x } for example and not { v, w } +*) + +PROCEDURE ComponentCreateFieldList (sym: CARDINAL) : List ; +VAR + lst: List ; +BEGIN + InitList (lst) ; + IF IsVar (sym) AND IsComponent (sym) + THEN + ComponentBuildFieldList (lst, sym) + END ; + RETURN lst +END ComponentCreateFieldList ; + + +PROCEDURE ComponentBuildFieldList (lst: List; sym: CARDINAL) ; +VAR + i, nsym: CARDINAL ; +BEGIN + i := 1 ; + REPEAT + nsym := GetNth (sym, i) ; + IF nsym # NulSym + THEN + IF IsComponent (nsym) + THEN + ComponentBuildFieldList (lst, nsym) + ELSIF IsRecordField (nsym) + THEN + IncludeItemIntoList (lst, nsym) + END ; + INC (i) + END + UNTIL nsym = NulSym +END ComponentBuildFieldList ; + + +(* + SetVarComponentInitialized - +*) + +PROCEDURE SetVarComponentInitialized (sym: CARDINAL) ; +VAR + i, n, + fsym, + vsym: CARDINAL ; + lst : List ; +BEGIN + vsym := ComponentFindVar (sym) ; + IF vsym # NulSym + THEN + IF Debugging + THEN + printf0 ("*************** vsym is: ") ; + PrintSym (vsym) + END ; + (* Build list accessing the field. *) + lst := ComponentCreateFieldList (sym) ; + IF Debugging + THEN + printf2 ("sym = %d, vsym = %d, fields:", sym, vsym) + END ; + (* Now mark this field in the record variable as initialized. *) + IF PutVarFieldInitialized (vsym, RightValue, lst) + THEN + IF Debugging + THEN + i := 1 ; + n := NoOfItemsInList (lst) ; + WHILE i <= n DO + fsym := GetItemFromList (lst, i) ; + printf1 (" %d", fsym) ; + INC (i) + END ; + printf0 (" is initialized\n") + END + ELSIF Debugging + THEN + printf0 (" vsym is not a var\n") + END ; + KillList (lst) + END +END SetVarComponentInitialized ; + + +(* + GetVarComponentInitialized - +*) + +PROCEDURE GetVarComponentInitialized (sym: CARDINAL) : BOOLEAN ; +VAR + init: BOOLEAN ; + vsym: CARDINAL ; + lst : List ; +BEGIN + init := FALSE ; + vsym := ComponentFindVar (sym) ; + IF vsym # NulSym + THEN + 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 GetVarComponentInitialized ; + + +(* + Trace - +*) + +PROCEDURE Trace (message: ARRAY OF CHAR; sym: CARDINAL) ; +BEGIN + IF Debugging + THEN + printf1 (message, sym) ; + printf0 ("\n") + END +END Trace ; + + +(* + SetVarInitialized - if the variable has a left mode and can be dereferenced + then set the left and right initialization state. +*) + +PROCEDURE SetVarInitialized (sym: CARDINAL; canDereference: BOOLEAN) ; +BEGIN + IF IsVar (sym) + THEN + IF IsComponent (sym) + THEN + Trace ("SetVarInitialized sym %d is a component and calling SetVarComponentInitialized", sym); + SetVarComponentInitialized (sym) + ELSIF (GetMode (sym) = LeftValue) AND canDereference + THEN + Trace ("SetVarInitialized sym %d is LeftValue and canDeference and calling PutVarInitialized LeftValue and RightValue", sym); + PutVarInitialized (sym, LeftValue) ; + PutVarInitialized (sym, RightValue) + ELSE + Trace ("SetVarInitialized sym %d calling PutVarInitialized with its mode", sym); + PutVarInitialized (sym, GetMode (sym)) + END ; + IF Debugging + THEN + PrintSym (sym) + END + END +END SetVarInitialized ; + + +(* + doGetVarInitialized - +*) + +PROCEDURE doGetVarInitialized (sym: CARDINAL) : BOOLEAN ; +BEGIN + IF IsVar (sym) + THEN + IF IsUnbounded (GetSType (sym)) + THEN + RETURN TRUE + ELSIF IsComponent (sym) + THEN + RETURN GetVarComponentInitialized (sym) + END ; + RETURN VarCheckReadInit (sym, GetMode (sym)) + END ; + RETURN IsConst (sym) AND IsConstString (sym) +END doGetVarInitialized ; + + +(* + GetVarInitialized - +*) + +PROCEDURE GetVarInitialized (sym: CARDINAL) : BOOLEAN ; +VAR + init: BOOLEAN ; +BEGIN + init := doGetVarInitialized (sym) ; + IF Debugging + THEN + IF init + THEN + Trace ("GetVarInitialized (sym = %d) returning TRUE", sym) + ELSE + Trace ("GetVarInitialized (sym = %d) returning FALSE", sym) + END + END ; + RETURN init +END GetVarInitialized ; + + +(* + IsExempt - returns TRUE if sym is a global variable or a parameter or + a variable with a variant record type. +*) + +PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ; +BEGIN + RETURN (sym # NulSym) AND IsVar (sym) AND + (IsGlobalVar (sym) OR IsVarAParam (sym) OR + ContainsVariant (GetSType (sym)) OR + IsArray (GetSType (sym)) OR IsSet (GetSType (sym)) OR + IsUnbounded (GetSType (sym))) +END IsExempt ; + + +(* + CheckBinary - +*) + +PROCEDURE CheckBinary (procSym, + op1tok, op1, + op2tok, op2, + op3tok, op3: CARDINAL) ; +BEGIN + CheckDeferredRecordAccess (procSym, op2tok, op2, FALSE) ; + CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) ; + SetVarInitialized (op1, FALSE) +END CheckBinary ; + + +(* + CheckUnary - +*) + +PROCEDURE CheckUnary (procSym, + lhstok, lhs, + rhstok, rhs: CARDINAL) ; +BEGIN + CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE) ; + SetVarInitialized (lhs, FALSE) +END CheckUnary ; + + +(* + CheckXIndr - +*) + +PROCEDURE CheckXIndr (procSym, lhstok, lhs, type, rhstok, rhs: CARDINAL) ; +VAR + lst : List ; + vsym: CARDINAL ; +BEGIN + CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE) ; + CheckDeferredRecordAccess (procSym, lhstok, lhs, FALSE) ; + (* 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) + THEN + IF IsRecord (type) + THEN + (* Set all fields of vsym as initialized. *) + SetVarInitialized (vsym, FALSE) + ELSE + (* Set only the field assigned in vsym as initialized. *) + lst := ComponentCreateFieldList (rhs) ; + IF PutVarFieldInitialized (vsym, RightValue, lst) + THEN + END ; + KillList (lst) + END + END +END CheckXIndr ; + + +(* + CheckIndrX - +*) + +PROCEDURE CheckIndrX (procSym, lhstok, lhs, type, rhstok, rhs: CARDINAL) ; +BEGIN + CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE) ; + CheckDeferredRecordAccess (procSym, rhstok, rhs, TRUE) ; + SetVarInitialized (lhs, FALSE) +END CheckIndrX ; + + +(* + CheckRecordField - +*) + +PROCEDURE CheckRecordField (procSym, op1tok, op1, op2tok, op2: CARDINAL) ; +BEGIN + PutVarInitialized (op1, LeftValue) +END CheckRecordField ; + + +(* + CheckBecomes - +*) + +PROCEDURE CheckBecomes (procSym, destok, des, exprtok, expr: CARDINAL) ; +VAR + lst : List ; + vsym: CARDINAL ; +BEGIN + CheckDeferredRecordAccess (procSym, exprtok, expr, FALSE) ; + SetupAlias (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) + THEN + END ; + KillList (lst) + END +END CheckBecomes ; + + +(* + CheckComparison - +*) + +PROCEDURE CheckComparison (procSym, op1tok, op1, op2tok, op2: CARDINAL) ; +BEGIN + CheckDeferredRecordAccess (procSym, op1tok, op1, FALSE) ; + CheckDeferredRecordAccess (procSym, op2tok, op2, FALSE) +END CheckComparison ; + + +(* + CheckAddr - +*) + +PROCEDURE CheckAddr (procSym, op1tok, op1, op3tok, op3: CARDINAL) ; +BEGIN + SetVarInitialized (op1, GetVarInitialized (op3)) ; + SetupAlias (op1, op3) +END CheckAddr ; + + +(* + DefaultTokPos - +*) + +PROCEDURE DefaultTokPos (preferredPos, defaultPos: CARDINAL) : CARDINAL ; +BEGIN + IF preferredPos = UnknownTokenNo + THEN + RETURN defaultPos + END ; + RETURN preferredPos +END DefaultTokPos ; + + +(* + stop - +*) + +PROCEDURE stop ; +END stop ; + + +(* + CheckReadBeforeInitQuad - +*) + +PROCEDURE CheckReadBeforeInitQuad (procSym: CARDINAL; quad: CARDINAL) : BOOLEAN ; +VAR + op : QuadOperator ; + op1, op2, op3 : CARDINAL ; + op1tok, op2tok, op3tok, qtok: CARDINAL ; + overflowChecking : BOOLEAN ; +BEGIN + IF quad = 3140 + THEN + stop + END ; + IF Debugging + THEN + printf1 ("CheckReadBeforeInitQuad (quad %d)\n", quad) ; + DumpAliases ; + ForeachLocalSymDo (procSym, PrintSym) ; + printf0 ("***********************************\n") + END ; + GetQuadOtok (quad, qtok, op, op1, op2, op3, overflowChecking, + op1tok, op2tok, op3tok) ; + op1tok := DefaultTokPos (op1tok, qtok) ; + op2tok := DefaultTokPos (op2tok, qtok) ; + op3tok := DefaultTokPos (op3tok, qtok) ; + CASE op OF + + (* Jumps, calls and branches. *) + IfInOp, + IfNotInOp, + IfEquOp, + IfNotEquOp, + IfLessOp, + IfLessEquOp, + IfGreOp, + IfGreEquOp : CheckComparison (procSym, op1tok, op1, op2tok, op2) | + TryOp, + ReturnOp, + CallOp, + KillLocalVarOp, + RetryOp, + GotoOp : RETURN TRUE | (* End of basic block. *) + + (* Variable references. *) + + InclOp, + ExclOp : CheckDeferredRecordAccess (procSym, op1tok, op1, FALSE) ; + CheckDeferredRecordAccess (procSym, op1tok, op1, TRUE) ; + CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) | + NegateOp : CheckUnary (procSym, op1tok, op1, op3tok, op3) | + BecomesOp : CheckBecomes (procSym, op1tok, op1, op3tok, op3) | + UnboundedOp, + FunctValueOp, + HighOp, + SizeOp : SetVarInitialized (op1, FALSE) | + AddrOp : CheckAddr (procSym, op1tok, op1, op3tok, op3) | + ReturnValueOp : SetVarInitialized (op1, FALSE) | + NewLocalVarOp : | + ParamOp : CheckDeferredRecordAccess (procSym, op2tok, op2, FALSE) ; + CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) ; + IF (op1 > 0) AND (op1 <= NoOfParam (op2)) AND + IsVarParam (op2, op1) + THEN + SetVarInitialized (op3, TRUE) + END | + ArrayOp : CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) ; + SetVarInitialized (op1, TRUE) | + RecordFieldOp : CheckRecordField (procSym, op1tok, op1, op2tok, op2) | + LogicalShiftOp, + LogicalRotateOp, + LogicalOrOp, + LogicalAndOp, + LogicalXorOp, + CoerceOp, + ConvertOp, + CastOp, + AddOp, + ArithAddOp, + SubOp, + MultOp, + DivM2Op, + ModM2Op, + ModFloorOp, + DivCeilOp, + ModCeilOp, + DivFloorOp, + ModTruncOp, + DivTruncOp : CheckBinary (procSym, + op1tok, op1, op2tok, op2, op3tok, op3) | + XIndrOp : CheckXIndr (procSym, op1tok, op1, op2, op3tok, op3) | + IndrXOp : CheckIndrX (procSym, op1tok, op1, op2, op3tok, op3) | + RangeCheckOp : | + SaveExceptionOp : SetVarInitialized (op1, FALSE) | + RestoreExceptionOp: CheckDeferredRecordAccess (procSym, op1tok, op1, FALSE) + + ELSE + END ; + RETURN FALSE +END CheckReadBeforeInitQuad ; + + +(* + FilterCheckReadBeforeInitQuad - +*) + +PROCEDURE FilterCheckReadBeforeInitQuad (procSym: CARDINAL; start: CARDINAL) : BOOLEAN ; +VAR + Op : QuadOperator ; + Op1, Op2, Op3: CARDINAL ; +BEGIN + GetQuad (start, Op, Op1, Op2, Op3) ; + IF (Op # RangeCheckOp) AND (Op # StatementNoteOp) + THEN + RETURN CheckReadBeforeInitQuad (procSym, start) + END ; + RETURN FALSE +END FilterCheckReadBeforeInitQuad ; + + +(* + CheckReadBeforeInitFirstBasicBlock - +*) + +PROCEDURE CheckReadBeforeInitFirstBasicBlock (procSym: CARDINAL; + start, end: CARDINAL) ; +BEGIN + ForeachLocalSymDo (procSym, SetVarUninitialized) ; + LOOP + IF FilterCheckReadBeforeInitQuad (procSym, start) OR (start = end) + THEN + RETURN + END ; + start := GetNextQuad (start) + END +END CheckReadBeforeInitFirstBasicBlock ; + + +(* + VariableAnalysis - checks to see whether a variable is: + + read before it has been initialized +*) + +PROCEDURE VariableAnalysis (Start, End: CARDINAL) ; +VAR + Op : QuadOperator ; + Op1, Op2, Op3: CARDINAL ; +BEGIN + IF UninitVariableChecking + THEN + GetQuad (Start, Op, Op1, Op2, Op3) ; + CASE Op OF + + NewLocalVarOp: initBlock ; + CheckReadBeforeInitFirstBasicBlock (Op3, Start, End) ; + killBlock + + ELSE + END + END +END VariableAnalysis ; + + +(* + DumpAlias - +*) + +PROCEDURE DumpAlias (aliasIndex: CARDINAL) ; +VAR + sa: symAlias ; +BEGIN + sa := Indexing.GetIndice (aliasArray, aliasIndex) ; + printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias) ; +END DumpAlias ; + + +(* + DumpAliases - +*) + +PROCEDURE DumpAliases ; +VAR + i, n: CARDINAL ; +BEGIN + IF Debugging + THEN + i := 1 ; + n := Indexing.HighIndice (aliasArray) ; + WHILE i <= n DO + DumpAlias (i) ; + INC (i) + END + END +END DumpAliases ; + + +(* + newAlias - +*) + +PROCEDURE newAlias () : symAlias ; +VAR + sa: symAlias ; +BEGIN + IF freeList = NIL + THEN + NEW (sa) + ELSE + sa := freeList ; + freeList := freeList^.next + END ; + RETURN sa +END newAlias ; + + +(* + initAlias - +*) + +PROCEDURE initAlias (sym: CARDINAL) : symAlias ; +VAR + sa: symAlias ; +BEGIN + sa := newAlias () ; + WITH sa^ DO + keySym := sym ; + alias := NulSym ; + next := NIL + END ; + RETURN sa +END initAlias ; + + +(* + killAlias - +*) + +PROCEDURE killAlias (sa: symAlias) ; +BEGIN + sa^.next := freeList ; + freeList := sa +END killAlias ; + + +(* + initBlock - +*) + +PROCEDURE initBlock ; +BEGIN + aliasArray := Indexing.InitIndex (1) ; +END initBlock ; + + +(* + killBlock - +*) + +PROCEDURE killBlock ; +VAR + i, n: CARDINAL ; +BEGIN + i := 1 ; + n := Indexing.HighIndice (aliasArray) ; + WHILE i <= n DO + killAlias (Indexing.GetIndice (aliasArray, i)) ; + INC (i) + END ; + aliasArray := Indexing.KillIndex (aliasArray) +END killBlock ; + + +(* + addAlias - +*) + +PROCEDURE addAlias (sym: CARDINAL; aliased: CARDINAL) ; +VAR + i, n: CARDINAL ; + sa : symAlias ; +BEGIN + i := 1 ; + n := Indexing.HighIndice (aliasArray) ; + WHILE i <= n DO + sa := Indexing.GetIndice (aliasArray, i) ; + IF sa^.keySym = sym + THEN + sa^.alias := aliased ; + RETURN + END ; + INC (i) + END ; + sa := initAlias (sym) ; + Indexing.IncludeIndiceIntoIndex (aliasArray, sa) ; + sa^.alias := aliased +END addAlias ; + + +(* + lookupAlias - +*) + +PROCEDURE lookupAlias (sym: CARDINAL) : symAlias ; +VAR + i, n: CARDINAL ; + sa : symAlias ; +BEGIN + i := 1 ; + n := Indexing.HighIndice (aliasArray) ; + WHILE i <= n DO + sa := Indexing.GetIndice (aliasArray, i) ; + IF sa^.keySym = sym + THEN + RETURN sa + END ; + INC (i) + END ; + RETURN NIL +END lookupAlias ; + + +(* + doGetAlias - +*) + +PROCEDURE doGetAlias (sym: CARDINAL) : CARDINAL ; +VAR + sa: symAlias ; +BEGIN + sa := lookupAlias (sym) ; + IF (sa # NIL) AND (sa^.alias # NulSym) + THEN + RETURN sa^.alias + END ; + RETURN NulSym +END doGetAlias ; + + +(* + getAlias - attempts to looks up an alias which is not a temporary variable. +*) + +PROCEDURE getAlias (sym: CARDINAL) : CARDINAL ; +VAR + type, + nsym: CARDINAL ; +BEGIN + nsym := sym ; + REPEAT + sym := nsym ; + type := GetSType (sym) ; + IF (IsTemporary (sym) AND (GetMode (sym) = LeftValue)) OR + ((type # NulSym) AND IsReallyPointer (type)) + THEN + nsym := doGetAlias (sym) + ELSE + RETURN sym + END + UNTIL nsym = NulSym ; + RETURN sym +END getAlias ; + + +(* + SetupAlias - +*) + +PROCEDURE SetupAlias (des, exp: CARDINAL) ; +BEGIN + IF IsVar (exp) AND + ((GetMode (des) = LeftValue) OR IsReallyPointer (GetSType (des))) + THEN + addAlias (des, exp) ; + DumpAliases + END +END SetupAlias ; + + +(* + init - +*) + +PROCEDURE init ; +BEGIN + freeList := NIL +END init ; + + +BEGIN + init +END M2SymInit. diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def index 5249952..c861cff 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.def +++ b/gcc/m2/gm2-compiler/SymbolTable.def @@ -355,7 +355,10 @@ EXPORT QUALIFIED NulSym, PopOffset, PopSumOfParamSize, DisplayTrees, - DebugLineNumbers ; + DebugLineNumbers, + VarCheckReadInit, VarInitState, PutVarInitialized, + PutVarFieldInitialized, GetVarFieldInitialized, + PrintInitialized ; (* @@ -3558,4 +3561,51 @@ PROCEDURE IsModuleBuiltin (sym: CARDINAL) : BOOLEAN ; PROCEDURE PutModuleBuiltin (sym: CARDINAL; value: BOOLEAN) ; +(* + VarCheckReadInit - returns TRUE if sym has been initialized. +*) + +PROCEDURE VarCheckReadInit (sym: CARDINAL; mode: ModeOfAddr) : BOOLEAN ; + + +(* + VarInitState - initializes the init state for variable sym. +*) + +PROCEDURE VarInitState (sym: CARDINAL) ; + + +(* + PutVarInitialized - set sym as initialized. +*) + +PROCEDURE PutVarInitialized (sym: CARDINAL; mode: ModeOfAddr) ; + + +(* + PutVarFieldInitialized - records that field has been initialized with + variable sym. TRUE is returned if the field + is detected and changed to initialized. +*) + +PROCEDURE PutVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr; + fieldlist: List) : BOOLEAN ; + + +(* + GetVarFieldInitialized - return TRUE if fieldlist has been initialized + within variable sym. +*) + +PROCEDURE GetVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr; + fieldlist: List) : BOOLEAN ; + + +(* + PrintInitialized - display variable sym initialization state. +*) + +PROCEDURE PrintInitialized (sym: CARDINAL) ; + + END SymbolTable. diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index ad3788d..c10e20c 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -87,6 +87,10 @@ FROM M2Comp IMPORT CompilingDefinitionModule, FROM FormatStrings IMPORT HandleEscape ; FROM M2Scaffold IMPORT DeclareArgEnvParams ; +FROM M2SymInit IMPORT InitDesc, InitSymInit, GetInitialized, ConfigSymInit, + SetInitialized, SetFieldInitialized, GetFieldInitialized, + PrintSymInit ; + IMPORT Indexing ; @@ -118,6 +122,8 @@ TYPE LRLists = ARRAY [RightValue..LeftValue] OF List ; + LRInitDesc = ARRAY [RightValue..LeftValue] OF InitDesc ; + TypeOfSymbol = (RecordSym, VarientSym, DummySym, VarSym, EnumerationSym, SubrangeSym, ArraySym, ConstStringSym, ConstVarSym, ConstLitSym, @@ -519,6 +525,7 @@ TYPE IsWritten : BOOLEAN ; (* Is variable written to? *) IsSSA : BOOLEAN ; (* Is variable a SSA? *) IsConst : BOOLEAN ; (* Is variable read/only? *) + InitState : LRInitDesc ; (* Initialization state. *) At : Where ; (* Where was sym declared/used *) ReadUsageList, (* list of var read quads *) WriteUsageList: LRLists ; (* list of var write quads *) @@ -4258,7 +4265,9 @@ BEGIN InitList(ReadUsageList[RightValue]) ; InitList(WriteUsageList[RightValue]) ; InitList(ReadUsageList[LeftValue]) ; - InitList(WriteUsageList[LeftValue]) + InitList(WriteUsageList[LeftValue]) ; + InitState[LeftValue] := InitSymInit () ; + InitState[RightValue] := InitSymInit () END END ; (* Add Var to Procedure or Module variable list. *) @@ -6696,7 +6705,9 @@ BEGIN WITH pSym^ DO CASE SymbolType OF - VarSym : Var.Type := VarType | + VarSym : Var.Type := VarType ; + ConfigSymInit (Var.InitState[LeftValue], Sym) ; + ConfigSymInit (Var.InitState[RightValue], Sym) | ConstVarSym: ConstVar.Type := VarType ELSE @@ -7933,7 +7944,7 @@ BEGIN IsHiddenTypeDeclared(CurrentModule) AND (TypeName#NulName) THEN - (* Check to see whether we are declaring a HiddenType. *) + (* Check to see whether we are declaring a HiddenType. *) pSym := GetPsym(CurrentModule) ; WITH pSym^ DO CASE SymbolType OF @@ -14446,6 +14457,162 @@ END GetDefaultRecordFieldAlignment ; (* + VarCheckReadInit - returns TRUE if sym has been initialized. +*) + +PROCEDURE VarCheckReadInit (sym: CARDINAL; mode: ModeOfAddr) : BOOLEAN ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: RETURN GetInitialized (Var.InitState[mode]) + + ELSE + END + END + END ; + RETURN FALSE +END VarCheckReadInit ; + + +(* + VarInitState - initializes the init state for variable sym. +*) + +PROCEDURE VarInitState (sym: CARDINAL) ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: ConfigSymInit (Var.InitState[LeftValue], sym) ; + ConfigSymInit (Var.InitState[RightValue], sym) + + ELSE + END + END + END +END VarInitState ; + + +(* + PutVarInitialized - set sym as initialized. +*) + +PROCEDURE PutVarInitialized (sym: CARDINAL; mode: ModeOfAddr) ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: WITH Var DO + SetInitialized (InitState[mode]) + END + + ELSE + END + END + END +END PutVarInitialized ; + + +(* + PutVarFieldInitialized - records that field has been initialized with + variable sym. TRUE is returned if the field + is detected and changed to initialized. +*) + +PROCEDURE PutVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr; + fieldlist: List) : BOOLEAN ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: WITH Var DO + RETURN SetFieldInitialized (InitState[mode], fieldlist) + END + + ELSE + END + END + END ; + RETURN FALSE +END PutVarFieldInitialized ; + + +(* + GetVarFieldInitialized - return TRUE if fieldlist has been initialized + within variable sym. +*) + +PROCEDURE GetVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr; + fieldlist: List) : BOOLEAN ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: WITH Var DO + RETURN GetFieldInitialized (InitState[mode], fieldlist) + END + + ELSE + END + END + END ; + RETURN FALSE +END GetVarFieldInitialized ; + + +(* + PrintInitialized - display variable sym initialization state. +*) + +PROCEDURE PrintInitialized (sym: CARDINAL) ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: printf0 ("LeftMode init: ") ; + PrintSymInit (Var.InitState[LeftValue]) ; + printf0 ("RightMode init: ") ; + PrintSymInit (Var.InitState[RightValue]) + + ELSE + END + END + END +END PrintInitialized ; + + +(* DumpSymbols - display all symbol numbers and their type. *) diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h index 767b617..e203fce4 100644 --- a/gcc/m2/gm2-gcc/m2options.h +++ b/gcc/m2/gm2-gcc/m2options.h @@ -136,6 +136,8 @@ EXTERN void M2Options_SetM2Prefix (const char *arg); EXTERN char *M2Options_GetM2Prefix (void); EXTERN void M2Options_SetM2PathName (const char *arg); EXTERN char *M2Options_GetM2PathName (void); +EXTERN void M2Options_SetUninitVariableChecking (bool value); + #undef EXTERN #endif /* m2options_h. */ diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc index fe52393..ae999a3 100644 --- a/gcc/m2/gm2-lang.cc +++ b/gcc/m2/gm2-lang.cc @@ -469,6 +469,9 @@ gm2_langhook_handle_option ( case OPT_Wunused_parameter: M2Options_SetUnusedParameterChecking (value); return 1; + case OPT_Wuninit_variable_checking: + M2Options_SetUninitVariableChecking (value); + return 1; case OPT_fm2_strict_type: M2Options_SetStrictTypeChecking (value); return 1; diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt index 7a0edb7..6dbdf9d 100644 --- a/gcc/m2/lang.opt +++ b/gcc/m2/lang.opt @@ -293,6 +293,10 @@ Wunused-parameter Modula-2 ; Documented in c.opt +Wuninit-variable-checking +Modula-2 +turns on compile time analysis in the first basic block of a procedure detecting access to uninitialized data. + B Modula-2 ; Documented in c.opt diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/switches-uninit-variable-checking-fail.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/switches-uninit-variable-checking-fail.exp new file mode 100644 index 0000000..36b36d2 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/switches-uninit-variable-checking-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/fail" -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-fail $testcase +} diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testinit.mod new file mode 100644 index 0000000..cc5b60b --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testinit.mod @@ -0,0 +1,17 @@ +MODULE testinit ; + + +PROCEDURE test ; +VAR + p: CARDINAL ; +BEGIN + (* p := 6 ; *) + IF p = 6 + THEN + END +END test ; + + +BEGIN + test +END testinit. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge.mod new file mode 100644 index 0000000..8503c17 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge.mod @@ -0,0 +1,27 @@ +MODULE testlarge ; + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.fg.r := 1 ; + p.fg.g := 2 ; + (* p.fg.b := 3 ; *) + p.bg := p.fg ; (* this should result in a warning. *) + IF p.bg.b = 6 + THEN + END +END test ; + +BEGIN + test +END testlarge. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge2.mod new file mode 100644 index 0000000..803f5ca --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge2.mod @@ -0,0 +1,24 @@ +MODULE testlarge2 ; + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.fg.r := 1 ; + p.fg.g := 2 ; + p.fg.g := 3 ; (* Deliberate typo should be p.fg.b. *) + p.bg := p.fg ; (* This should result in a warning. *) +END test ; + +BEGIN + test +END testlarge2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit.mod new file mode 100644 index 0000000..15bd1df --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit.mod @@ -0,0 +1,31 @@ +MODULE testrecinit ; + + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.fg.r := 1 ; + p.fg.g := 2 ; + p.fg.b := 3 ; + p.bg.r := 4 ; + p.bg.g := 5 ; + (* p.bg.b := 6 ; *) + (* forget to initialize p.bg.b *) + IF p.bg.b = 6 (* should catch error. *) + THEN + END +END test ; + +BEGIN + test +END testrecinit. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit2.mod new file mode 100644 index 0000000..decce3b --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit2.mod @@ -0,0 +1,25 @@ +MODULE testrecinit ; + + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.fg.r := 1 ; + IF p.fg.g = 6 (* should catch error. *) + THEN + END +END test ; + +BEGIN + test +END testrecinit. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit5.mod new file mode 100644 index 0000000..c67620a --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit5.mod @@ -0,0 +1,25 @@ +MODULE testrecinit5 ; + + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + (* p.bg.b := 6 ; *) + IF p.bg.b = 6 + THEN + END +END test ; + +BEGIN + test +END testrecinit5. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec.mod new file mode 100644 index 0000000..ce97473 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec.mod @@ -0,0 +1,22 @@ +MODULE testsmallrec ; + + +TYPE + vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + v: vec ; +BEGIN + (* v.x := 1 ; *) + v.y := 2 ; + IF v.x = 1 (* This line should be the cause of a warning. *) + THEN + END +END test ; + +BEGIN + test +END testsmallrec. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod new file mode 100644 index 0000000..c0be5d9 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod @@ -0,0 +1,24 @@ +MODULE testsmallrec2 ; + + +TYPE + vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + v: vec ; +BEGIN + (* v.x := 1 ; *) + v.y := 2 ; + WITH v DO + IF x = 1 + THEN + END + END +END test ; + +BEGIN + test +END testsmallrec2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallvec.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallvec.mod new file mode 100644 index 0000000..1e55bd1 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallvec.mod @@ -0,0 +1,20 @@ +MODULE testsmallvec ; + +TYPE + vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + v: vec ; +BEGIN + IF v.x = 2 + THEN + END +END test ; + + +BEGIN + test +END testsmallvec. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testvarinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testvarinit.mod new file mode 100644 index 0000000..8f188eb --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testvarinit.mod @@ -0,0 +1,17 @@ +MODULE testvarinit ; + + +PROCEDURE test ; +VAR + x: CARDINAL ; +BEGIN + (* x := 1 ; *) + IF x = 1 + THEN + END +END test ; + + +BEGIN + test +END testvarinit. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod new file mode 100644 index 0000000..3836470 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod @@ -0,0 +1,29 @@ +MODULE testwithnoptr ; + +TYPE + Vec = RECORD + x, y: CARDINAL ; + END ; + + +(* + test - +*) + +PROCEDURE test ; +VAR + p: Vec ; +BEGIN + WITH p DO + x := 1 ; + x := 2 (* deliberate typo - should be y *) + END ; + IF p.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testwithnoptr. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr.mod new file mode 100644 index 0000000..063ddc4 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr.mod @@ -0,0 +1,34 @@ +MODULE testwithptr ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: CARDINAL ; + END ; + + +(* + test - +*) + +PROCEDURE test ; +VAR + p: PtrToVec ; + v: Vec ; +BEGIN + p := ADR (v) ; + WITH p^ DO + x := 1 ; + x := 2 (* deliberate typo - should be y *) + END ; + IF p^.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testwithptr. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr2.mod new file mode 100644 index 0000000..176b830 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr2.mod @@ -0,0 +1,30 @@ +MODULE testwithptr2 ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: CARDINAL ; + END ; + + +(* + test - +*) + +PROCEDURE test ; +VAR + p: PtrToVec ; +BEGIN + WITH p^ DO + x := 1 ; + x := 2 (* deliberate typo - should be y *) + END ; + IF p^.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testwithptr2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr3.mod new file mode 100644 index 0000000..b442a62 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr3.mod @@ -0,0 +1,21 @@ +MODULE testwithptr3 ; + +TYPE + ptr = POINTER TO vec ; + vec = RECORD + x, y: CARDINAL ; + END ; + + +PROCEDURE test ; +VAR + p: ptr ; +BEGIN + WITH p^ DO + + END +END test ; + +BEGIN + test +END testwithptr3. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/switches-uninit-variable-checking-pass.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/switches-uninit-variable-checking-pass.exp new file mode 100644 index 0000000..078daeb --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/switches-uninit-variable-checking-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/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/pass/testrecinit3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit3.mod new file mode 100644 index 0000000..872e875 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit3.mod @@ -0,0 +1,30 @@ +MODULE testrecinit3 ; + + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.fg.r := 1 ; + p.fg.g := 2 ; + p.fg.b := 3 ; + p.bg.r := 4 ; + p.bg.g := 5 ; + p.bg.b := 6 ; + IF p.bg.b = 6 + THEN + END +END test ; + +BEGIN + test +END testrecinit3. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit5.mod new file mode 100644 index 0000000..ea15c57 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit5.mod @@ -0,0 +1,25 @@ +MODULE testrecinit5 ; + + +TYPE + color = RECORD + r, g, b: CARDINAL ; + END ; + + pixel = RECORD + fg, bg: color ; + END ; + +PROCEDURE test ; +VAR + p: pixel ; +BEGIN + p.bg.b := 6 ; + IF p.bg.b = 6 + THEN + END +END test ; + +BEGIN + test +END testrecinit5. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec.mod new file mode 100644 index 0000000..37d855c --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec.mod @@ -0,0 +1,22 @@ +MODULE testsmallrec ; + + +TYPE + vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + v: vec ; +BEGIN + v.x := 1 ; + v.y := 2 ; + IF v.x = 1 + THEN + END +END test ; + +BEGIN + test +END testsmallrec. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod new file mode 100644 index 0000000..095d72e --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod @@ -0,0 +1,24 @@ +MODULE testsmallrec2 ; + + +TYPE + vec = RECORD + x, y: CARDINAL ; + END ; + +PROCEDURE test ; +VAR + v: vec ; +BEGIN + v.x := 1 ; + v.y := 2 ; + WITH v DO + IF x = 1 + THEN + END + END +END test ; + +BEGIN + test +END testsmallrec2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testvarinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testvarinit.mod new file mode 100644 index 0000000..8229bef --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testvarinit.mod @@ -0,0 +1,17 @@ +MODULE testvarinit ; + + +PROCEDURE test ; +VAR + x: CARDINAL ; +BEGIN + x := 1 ; + IF x = 1 + THEN + END +END test ; + + +BEGIN + test +END testvarinit. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr.mod new file mode 100644 index 0000000..90d6373 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr.mod @@ -0,0 +1,34 @@ +MODULE testwithptr ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: CARDINAL ; + END ; + + +(* + test - +*) + +PROCEDURE test ; +VAR + p: PtrToVec ; + v: Vec ; +BEGIN + p := ADR (v) ; + WITH p^ DO + x := 1 ; + y := 2 + END ; + IF p^.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testwithptr. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr2.mod new file mode 100644 index 0000000..bb0c7b5 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr2.mod @@ -0,0 +1,31 @@ +MODULE testwithptr2 ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: CARDINAL ; + END ; + + +(* + test - +*) + +PROCEDURE test ; +VAR + p: PtrToVec ; + v: Vec ; +BEGIN + p := ADR (v) ; + p^ := Vec {1, 2} ; + IF p^.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testwithptr2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr3.mod new file mode 100644 index 0000000..71ffe1f --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr3.mod @@ -0,0 +1,31 @@ +MODULE testwithptr3 ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: CARDINAL ; + END ; + + +(* + test - +*) + +PROCEDURE test ; +VAR + p: PtrToVec ; + v: Vec ; +BEGIN + p := ADR (v) ; + v := Vec {1, 2} ; + IF p^.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testwithptr3. |