firebird/firebird-mirror
firebird/firebird-mirror
8
0
Fork 1
mirror of https://github.com/FirebirdSQL/firebird.git synced 2025-01-22 16:43:03 +01:00
Code Issues

Improvement #7542 : Compiler warnings raise when build cloop generated Firebird.pas in RAD Studio 11.3

Browse Source 
Also, fixed AV in FbException.catchException()
This commit is contained in:
Vlad Khorsun 2023-04-10 12:36:53 +03:00
parent d547e930c5
commit 308579c2f7
4 changed files with 456 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
extern/cloop/src/cloop/Generator.cpp vendored
View File

@ -1136,6 +1136,12 @@ void PascalGenerator::generate()
if (!isProcedure)
fprintf(out, ": %s", convertType(method->returnTypeRef).c_str());
// Methods that present in TObject should be "reintroduce"d.
// So far there is just one case. For more cases better solution required.
if (method->name == "toString")
fprintf(out, "; reintroduce");
fprintf(out, ";\n");
}
@ -1332,6 +1338,39 @@ void PascalGenerator::generate()
fprintf(out, "; cdecl;\n");
fprintf(out, "begin\n");
if (!isProcedure)
{
if (method->returnTypeRef.isPointer) {
fprintf(out, "\tResult := nil;\n");
}
else
{
char* sResult;
switch (method->returnTypeRef.token.type)
{
case Token::TYPE_STRING:
sResult = "nil";
break;
case Token::TYPE_BOOLEAN:
sResult = "false";
break;
case Token::TYPE_IDENTIFIER:
if (method->returnTypeRef.type == BaseType::TYPE_INTERFACE)
{
sResult = "nil";
break;
}
// fallthru
default:
sResult = "0";
break;
}
fprintf(out, "\tResult := %s;\n", sResult);
}
}
if (!exceptionClass.empty())
fprintf(out, "\ttry\n\t");

423
src/include/gen/Firebird.pas
View File

File diff suppressed because it is too large Load Diff

15
src/misc/pascal/Pascal.implementation.pas
View File

@ -24,32 +24,29 @@ end;
class procedure FbException.catchException(status: IStatus; e: Exception);
var
statusVector: array[0..4] of NativeIntPtr;
msg: AnsiString;
begin
if (not Assigned(status)) then
Exit;
if (e.inheritsFrom(FbException)) then
status.setErrors(FbException(e).getStatus.getErrors)
else
begin
msg := e.message;
statusVector[0] := NativeIntPtr(isc_arg_gds);
statusVector[1] := NativeIntPtr(isc_random);
statusVector[2] := NativeIntPtr(isc_arg_string);
statusVector[3] := NativeIntPtr(PAnsiChar(msg));
statusVector[3] := NativeIntPtr(PAnsiChar(AnsiString(e.message)));
statusVector[4] := NativeIntPtr(isc_arg_end);
status.setErrors(@statusVector);
end
end;
class procedure FbException.setVersionError(status: IStatus; interfaceName: string;
class procedure FbException.setVersionError(status: IStatus; interfaceName: AnsiString;
currentVersion, expectedVersion: NativeInt);
var
statusVector: array[0..8] of NativeIntPtr;
msg: AnsiString;
begin
msg := interfaceName;
statusVector[0] := NativeIntPtr(isc_arg_gds);
statusVector[1] := NativeIntPtr(isc_interface_version_too_old);
statusVector[2] := NativeIntPtr(isc_arg_number);
@ -57,7 +54,7 @@ begin
statusVector[4] := NativeIntPtr(isc_arg_number);
statusVector[5] := NativeIntPtr(currentVersion);
statusVector[6] := NativeIntPtr(isc_arg_string);
statusVector[7] := NativeIntPtr(PAnsiChar(msg));
statusVector[7] := NativeIntPtr(PAnsiChar(interfaceName));
statusVector[8] := NativeIntPtr(isc_arg_end);
status.setErrors(@statusVector);

2
src/misc/pascal/Pascal.interface.pas
View File

@ -7,7 +7,7 @@
class procedure checkException(status: IStatus);
class procedure catchException(status: IStatus; e: Exception);
class procedure setVersionError(status: IStatus; interfaceName: string;
class procedure setVersionError(status: IStatus; interfaceName: AnsiString;
currentVersion, expectedVersion: NativeInt);
private