bugs 212-214 + 252-253

This commit is contained in:
pierre 1999-05-30 23:07:32 +00:00
parent dcc1d5f92b
commit 3fa1d1b644
6 changed files with 214 additions and 0 deletions

18
tests/tbs0212.pp Normal file
View File

@ -0,0 +1,18 @@
program proptest;
type
TMyRec = record
Int: Integer;
Str: String;
end;
TMyClass = class
private
FMyRec: TMyRec;
public
property AnInt: Integer read FMyRec.Int;
property AStr: String read FMyRec.Str;
end;
begin
end.

35
tests/tbs0213.pp Normal file
View File

@ -0,0 +1,35 @@
uses
tbs0213a;
PROCEDURE Testsomething(VAR A:LONGINT);
FUNCTION Internaltest(L:LONGINT):LONGINT;
BEGIN
InternalTest:=L+10;
END;
BEGIN
A:=Internaltest(20)+5;
END;
PROCEDURE Testsomething(VAR A:WORD);
FUNCTION Internaltest(L:LONGINT):WORD;
BEGIN
InternalTest:=L+15;
END;
BEGIN
A:=Internaltest(20)+5;
END;
VAR O : LONGINT;
O2 : WORD;
BEGIN
TestSomething(O);
TestSomething(O2);
END.

96
tests/tbs0213a.pp Normal file
View File

@ -0,0 +1,96 @@
{ different tests for the problem of local
functions having the same name }
unit tbs0213a;
interface
PROCEDURE Testsomething(VAR A:LONGINT);
PROCEDURE Testsomething(VAR A:WORD);
implementation
PROCEDURE Testsomething(VAR A:LONGINT);
FUNCTION Internaltest(L:LONGINT):LONGINT;
BEGIN
InternalTest:=L+10;
END;
BEGIN
A:=Internaltest(20)+5;
END;
PROCEDURE Testsomething(VAR A:WORD);
FUNCTION Internaltest(L:LONGINT):WORD;
BEGIN
InternalTest:=L+15;
END;
BEGIN
A:=Internaltest(20)+5;
END;
PROCEDURE Testsomething2(VAR A:LONGINT);
FUNCTION Internaltest(L:LONGINT):LONGINT;
BEGIN
InternalTest:=L+10;
END;
BEGIN
A:=Internaltest(20)+5;
END;
PROCEDURE Testsomething2(VAR A:WORD);
FUNCTION Internaltest(L:LONGINT):WORD;
BEGIN
InternalTest:=L+15;
END;
BEGIN
A:=Internaltest(20)+5;
END;
PROCEDURE Testsomething3(VAR A:WORD);forward;
PROCEDURE Testsomething3(VAR A:LONGINT);
FUNCTION Internaltest(L:LONGINT):LONGINT;
BEGIN
InternalTest:=L+10;
END;
BEGIN
A:=Internaltest(20)+5;
END;
PROCEDURE Testsomething3(VAR A:WORD);
FUNCTION Internaltest(L:LONGINT):WORD;
BEGIN
InternalTest:=L+15;
END;
BEGIN
A:=Internaltest(20)+5;
END;
VAR O : LONGINT;
O2 : WORD;
BEGIN
TestSomething(O);
TestSomething(O2);
END.

29
tests/tbs0214.pp Normal file
View File

@ -0,0 +1,29 @@
{ $OPT=-St }
Program SttcTest;
{ Note: I've cut a lot out of this program, it did originally have
constructors, destructors and instanced objects, but this
is the minimum required to produce the problem, and I think
that this should work, unless I've misunderstood the use of
the static keyword. }
Type
TObjectType1 = Object
Procedure Setup; static;
Procedure Weird; static;
End;
Procedure TObjectType1.Setup;
Begin
End;
Procedure TObjectType1.Weird;
Begin
End;
Begin
TObjectType1.Setup;
TObjectType1.Weird;
TObjectType1.Weird; // GPFs before exiting "Weird"
Writeln('THE END.');
End.

18
tests/tbs0252.pp Normal file
View File

@ -0,0 +1,18 @@
type
wnd=procedure;
r=record
w : wnd;
end;
procedure p;
begin
end;
const
r1:r=(
w : wnd(@p);
);
begin
end.

18
tests/tbs0253.pp Normal file
View File

@ -0,0 +1,18 @@
procedure test(w : word);forward;
procedure test(a : string);
begin
Writeln(a);
test(20);
end;
procedure test(w :word);
begin
writeln(w);
end;
begin
test('test');
test(32);
end.