# HG changeset patch # User unc0rr # Date 1341341090 -14400 # Node ID 3c6f08af7dac3a3b10e25048d4a96644c83ec5a5 # Parent 520a16a14747c3919c491b8bea6a36b4cd71e94c - Don't call Length() on variable size arrays - Make pas2c fail on such calls diff -r 520a16a14747 -r 3c6f08af7dac hedgewars/GSHandlers.inc --- a/hedgewars/GSHandlers.inc Sat Jun 30 01:09:31 2012 +0400 +++ b/hedgewars/GSHandlers.inc Tue Jul 03 22:44:50 2012 +0400 @@ -3193,23 +3193,22 @@ //////////////////////////////////////////////////////////////////////////////// procedure doStepSeductionWork(Gear: PGear); var i: LongInt; - hogs: TPGearArray; + hogs: PGearArrayS; begin AllInactive := false; hogs := GearsNear(Gear^.X, Gear^.Y, gtHedgehog, Gear^.Radius); - if Length(hogs) > 0 then - begin - for i:= 0 to Length(hogs) - 1 do - begin - if hogs[i] <> CurrentHedgehog^.Gear then + if hogs.size > 0 then + begin + for i:= 0 to hogs.size - 1 do + with hogs.ar^[i]^ do begin - //d:= Distance(Gear^.X - hogs[i]^.X, Gear^.Y - hogs[i]^.Y); - hogs[i]^.dX:= _50 * cGravity * (Gear^.X - hogs[i]^.X) / _25; - //if Gear^.X < hogs[i]^.X then hogs[i]^.dX.isNegative:= true; - hogs[i]^.dY:= -_450 * cGravity; - hogs[i]^.Active:= true; - end - end; + if hogs.ar^[i] <> CurrentHedgehog^.Gear then + begin + dX:= _50 * cGravity * (Gear^.X - X) / _25; + dY:= -_450 * cGravity; + Active:= true; + end + end; end ; AfterAttack; DeleteGear(Gear); @@ -5062,7 +5061,7 @@ //////////////////////////////////////////////////////////////////////////////// procedure doStepResurrectorWork(Gear: PGear); var - graves: TPGearArray; + graves: PGearArrayS; resgear: PGear; hh: PHedgehog; i: LongInt; @@ -5097,7 +5096,7 @@ graves := GearsNear(Gear^.X, Gear^.Y, gtGrave, Gear^.Radius); - if Length(graves) = 0 then + if graves.size = 0 then begin StopSoundChan(Gear^.SoundChannel); Gear^.Timer := 250; @@ -5107,12 +5106,12 @@ if ((Gear^.Message and gmAttack) <> 0) and (hh^.Gear^.Health > 0) and (TurnTimeLeft > 0) then begin - if Length(graves) <= Gear^.Tag then Gear^.Tag:= 0; + if graves.size <= Gear^.Tag then Gear^.Tag:= 0; dec(hh^.Gear^.Health); if (hh^.Gear^.Health = 0) and (hh^.Gear^.Damage = 0) then hh^.Gear^.Damage:= 1; RenderHealth(hh^); - inc(graves[Gear^.Tag]^.Health); + inc(graves.ar^[Gear^.Tag]^.Health); inc(Gear^.Tag) {-for i:= 0 to High(graves) do begin if hh^.Gear^.Health > 0 then begin @@ -5124,14 +5123,14 @@ else begin // now really resurrect the hogs with the hp saved in the graves - for i:= 0 to Length(graves) - 1 do - if graves[i]^.Health > 0 then + for i:= 0 to graves.size - 1 do + if graves.ar^[i]^.Health > 0 then begin - resgear := AddGear(hwRound(graves[i]^.X), hwRound(graves[i]^.Y), gtHedgehog, gstWait, _0, _0, 0); - resgear^.Hedgehog := graves[i]^.Hedgehog; - resgear^.Health := graves[i]^.Health; - PHedgehog(graves[i]^.Hedgehog)^.Gear := resgear; - DeleteGear(graves[i]); + resgear := AddGear(hwRound(graves.ar^[i]^.X), hwRound(graves.ar^[i]^.Y), gtHedgehog, gstWait, _0, _0, 0); + resgear^.Hedgehog := graves.ar^[i]^.Hedgehog; + resgear^.Health := graves.ar^[i]^.Health; + PHedgehog(graves.ar^[i]^.Hedgehog)^.Gear := resgear; + DeleteGear(graves.ar^[i]); RenderHealth(resgear^.Hedgehog^); RecountTeamHealth(resgear^.Hedgehog^.Team); resgear^.Hedgehog^.Effects[heResurrected]:= 1; @@ -5153,18 +5152,18 @@ procedure doStepResurrector(Gear: PGear); var - graves: TPGearArray; + graves: PGearArrayS; i: LongInt; begin AllInactive := false; graves := GearsNear(Gear^.X, Gear^.Y, gtGrave, Gear^.Radius); - if Length(graves) > 0 then - begin - for i:= 0 to Length(graves) - 1 do + if graves.size > 0 then + begin + for i:= 0 to graves.size - 1 do begin - PHedgehog(graves[i]^.Hedgehog)^.Gear := nil; - graves[i]^.Health := 0; + PHedgehog(graves.ar^[i]^.Hedgehog)^.Gear := nil; + graves.ar^[i]^.Health := 0; end; Gear^.doStep := @doStepResurrectorWork; end @@ -5483,7 +5482,7 @@ HHGear, iter: PGear; ndX, ndY: hwFloat; i, t, gX, gY: LongInt; - hogs: TPGearArray; + hogs: PGearArrayS; begin HHGear := Gear^.Hedgehog^.Gear; if (Gear^.Health = 0) or (HHGear = nil) or (HHGear^.Damage <> 0) then @@ -5547,9 +5546,9 @@ // freeze nearby hogs if GameTicks mod 10 = 0 then dec(Gear^.Health); hogs := GearsNear(Gear^.X, Gear^.Y, gtHedgehog, Gear^.Radius); - if Length(hogs) > 0 then - for i:= 0 to Length(hogs) - 1 do - if hogs[i] <> HHGear then + if hogs.size > 0 then + for i:= 0 to hogs.size - 1 do + if hogs.ar^[i] <> HHGear then begin //if Gear^.Hedgehog^.Effects[heFrozen]:= 0; end; diff -r 520a16a14747 -r 3c6f08af7dac hedgewars/uGears.pas --- a/hedgewars/uGears.pas Sat Jun 30 01:09:31 2012 +0400 +++ b/hedgewars/uGears.pas Tue Jul 03 22:44:50 2012 +0400 @@ -65,7 +65,7 @@ procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward; //procedure AmmoFlameWork(Ammo: PGear); forward; -function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): TPGearArray; forward; +function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS; forward; procedure SpawnBoxOfSmth; forward; procedure ShotgunShot(Gear: PGear); forward; procedure doStepCase(Gear: PGear); forward; @@ -871,25 +871,30 @@ end end; -function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): TPGearArray; +var GearsNearArray : TPGearArray; +function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS; var t: PGear; - l: Longword; + s: Longword; begin r:= r*r; - GearsNear := nil; + s:= 0; + SetLength(GearsNearArray, s); t := GearsList; while t <> nil do begin if (t^.Kind = Kind) and ((X - t^.X)*(X - t^.X) + (Y - t^.Y)*(Y-t^.Y) < int2hwFloat(r)) then begin - l:= Length(GearsNear); - SetLength(GearsNear, l + 1); - GearsNear[l] := t; + inc(s); + SetLength(GearsNearArray, s); + GearsNearArray[s - 1] := t; end; t := t^.NextGear; end; + + GearsNear.size:= s; + GearsNear.ar:= @GearsNearArray end; {procedure AmmoFlameWork(Ammo: PGear); diff -r 520a16a14747 -r 3c6f08af7dac hedgewars/uTypes.pas --- a/hedgewars/uTypes.pas Sat Jun 30 01:09:31 2012 +0400 +++ b/hedgewars/uTypes.pas Tue Jul 03 22:44:50 2012 +0400 @@ -260,6 +260,10 @@ LastDamage: PHedgehog; end; TPGearArray = array of PGear; + PGearArrayS = record + size: LongWord; + ar: ^TPGearArray; + end; PVisualGear = ^TVisualGear; TVGearStepProcedure = procedure (Gear: PVisualGear; Steps: Longword); diff -r 520a16a14747 -r 3c6f08af7dac tools/pas2c.hs --- a/tools/pas2c.hs Sat Jun 30 01:09:31 2012 +0400 +++ b/tools/pas2c.hs Tue Jul 03 22:44:50 2012 +0400 @@ -842,7 +842,8 @@ modify (\s -> s{lastType = BTInt}) case lt of BTString -> return $ text "Length" <> parens e' - BTArray {} -> return $ text "length_ar" <> parens e' + BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e' + BTArray (RangeFromTo _ n) _ _ -> initExpr2C (BuiltInFunction "succ" [n]) _ -> error $ "length() called on " ++ show lt expr2C (BuiltInFunCall params ref) = do r <- ref2C ref