paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-29 02:23:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed converting vaInt8 and vaUTF8String

Browse Source 
git-svn-id: trunk@5963 -
This commit is contained in:
mattias 2004-09-10 22:14:47 +00:00
parent 18d67ba979
commit a22c29b480
4 changed files with 77 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/codetools/finddeclarationtool.pas
View File

@ -259,6 +259,7 @@ type
xtLongWord, // longword
xtWord, // word
xtSmallInt, // smallint
xtShortInt, // shortint
xtByte, // byte
xtCompilerFunc,// SUCC, PREC, LOW, HIGH, ORD, LENGTH, COPY (1.1)
xtNil // nil = pointer, class, procedure, method, ...
@ -301,6 +302,7 @@ const
'LongWord',
'Word',
'SmallInt',
'ShortInt',
'Byte',
'CompilerFunc',
'Nil'
@ -309,7 +311,8 @@ const
xtAllTypes = [Low(TExpressionTypeDesc)..High(TExpressionTypeDesc)]-[xtNone];
xtAllPredefinedTypes = xtAllTypes-[xtContext];
xtAllIntegerTypes = [xtInt64, xtQWord, xtConstOrdInteger, xtLongint,
xtLongWord, xtWord, xtCardinal, xtSmallInt, xtByte];
xtLongWord, xtWord, xtCardinal, xtSmallInt, xtShortInt,
xtByte];
xtAllBooleanTypes = [xtBoolean, xtByteBool, xtLongBool];
xtAllRealTypes = [xtReal, xtConstReal, xtSingle, xtDouble, xtExtended,
xtCurrency, xtComp];
@ -793,6 +796,8 @@ begin
Result:=xtCardinal
else if CompareIdentifiers(Identifier,'SMALLINT')=0 then
Result:=xtSmallInt
else if CompareIdentifiers(Identifier,'SHORTINT')=0 then
Result:=xtShortInt
else if CompareIdentifiers(Identifier,'BYTE')=0 then
Result:=xtByte
else
@ -6455,6 +6460,7 @@ begin
xtLongint,
xtLongWord,
xtSmallInt,
xtShortInt,
xtByte,
xtWord:
Result:=ExpressionTypeDescNames[ExprType.Desc];

1
components/codetools/keywordfunclists.pas
View File

@ -1212,6 +1212,7 @@ begin
Add('WORD' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('LONGINT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SMALLINT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SHORTINT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('BYTE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsPredefinedFPCIdentifier.Add(IsKeyWordBuiltInFunc);

5
ide/main.pp
View File

@ -6694,6 +6694,8 @@ begin
Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,true,
LazarusUnitFilename,LFMFilename);
if Result<>mrOk then exit;
if LFMFilename='' then LFMFilename:=ChangeFIleExt(LazarusUnitFilename,'.lfm');
HasDFMFile:=FileExists(LFMFilename);
// convert .dfm file to .lfm file
if HasDFMFile then begin
writeln('TMainIDE.DoConvertDelphiUnit Convert dfm format to lfm "',LFMFilename,'"');
@ -10644,6 +10646,9 @@ end.
{ =============================================================================
$Log$
Revision 1.767 2004/09/10 22:14:47 mattias
fixed converting vaInt8 and vaUTF8String
Revision 1.766 2004/09/04 21:54:08 marc
+ Added option to skip compiler step on compile, build or run
* Fixed adding of runtime watches

70
lcl/lresources.pp
View File

@ -1203,7 +1203,55 @@ procedure LRSObjectBinaryToText(Input, Output: TStream);
procedure Stop(const s: String);
begin
RaiseGDBException('ObjectLRSToText Unimplemented '+s);
RaiseGDBException('ObjectLRSToText '+s);
end;
procedure UnknownValueType;
var
HintStr, s: String;
HintLen: Int64;
begin
s:='';
case ValueType of
vaNull: s:='vaNull';
vaList: s:='vaList';
vaInt8: s:='vaInt8';
vaInt16: s:='vaInt16';
vaInt32: s:='vaInt32';
vaExtended: s:='vaExtended';
vaString: s:='vaString';
vaIdent: s:='vaIdent';
vaFalse: s:='vaFalse';
vaTrue: s:='vaTrue';
vaBinary: s:='vaBinary';
vaSet: s:='vaSet';
vaLString: s:='vaLString';
vaNil: s:='vaNil';
vaCollection: s:='vaCollection';
vaSingle: s:='vaSingle';
vaCurrency: s:='vaCurrency';
vaDate: s:='vaDate';
vaWString: s:='vaWString';
vaInt64: s:='vaInt64';
end;
if s<>'' then
s:='Unimplemented ValueType='+s
else
s:='Unknown ValueType='+dbgs(Ord(ValueType));
HintLen:=Output.Position;
if HintLen>50 then HintLen:=50;
SetLength(HintStr,HintLen);
if HintStr<>'' then begin
try
Output.Position:=Output.Position-length(HintStr);
Output.Read(HintStr[1],length(HintStr));
debugln('ObjectLRSToText:');
debugln(DbgStr(HintStr));
except
end;
end;
s:=s+' ';
Stop(s);
end;
procedure ProcessBinary;
@ -1242,6 +1290,7 @@ procedure LRSObjectBinaryToText(Input, Output: TStream);
{$endif HASWIDESTRING}
begin
//DbgOut('ValueType="',dbgs(ord(ValueType)),'"');
case ValueType of
vaList: begin
OutStr('(');
@ -1258,7 +1307,10 @@ procedure LRSObjectBinaryToText(Input, Output: TStream);
end;
OutLn(Indent + ')');
end;
vaInt8: OutLn(IntToStr(ShortInt(Input.ReadByte)));
vaInt8: begin
// MG: IntToStr has a bug with ShortInt, therefore these typecasts
OutLn(IntToStr(Integer(ShortInt(Input.ReadByte))));
end;
vaInt16: OutLn(IntToStr(SmallInt(ReadLRSWord(Input))));
vaInt32: OutLn(IntToStr(ReadLRSInteger(Input)));
vaInt64: OutLn(IntToStr(ReadLRSInt64(Input)));
@ -1327,10 +1379,16 @@ procedure LRSObjectBinaryToText(Input, Output: TStream);
OutLn(AWideString);
end;
{$endif HASWIDESTRING}
else begin
debugln('Unknown ValueType=',dbgs(Ord(ValueType)),' vaInt16=',dbgs(Ord(vaInt16)));
Stop(IntToStr(Ord(ValueType)));
end;
else
if ord(ValueType)=20 then begin
// vaUTF8String
// Delphi saves widestrings as UTF8 strings
// The LCL does not use widestrings, but UTF8 directly
// so, simply read the string
OutString(ReadLongString);
OutLn('');
end else
UnknownValueType;
end;
end;