paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-23 17:51:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* check function/procedure type when adding a proc definition

Browse Source 
git-svn-id: trunk@546 -
This commit is contained in:
peter 2005-06-30 14:56:05 +00:00
parent 3e97ec6295
commit c1b2e1aac5
10 changed files with 55 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -4423,6 +4423,7 @@ tests/tbf/tb0174a.pp svneol=native#text/plain
tests/tbf/tb0174b.pp svneol=native#text/plain
tests/tbf/tb0174c.pp svneol=native#text/plain
tests/tbf/tb0174d.pp svneol=native#text/plain
tests/tbf/tb0175.pp svneol=native#text/plain
tests/tbf/ub0115.pp svneol=native#text/plain
tests/tbf/ub0149.pp svneol=native#text/plain
tests/tbf/ub0158a.pp svneol=native#text/plain

2
compiler/arm/cgcpu.pas
View File

@ -1414,7 +1414,7 @@ unit cgcpu;
make_global : boolean;
href : treference;
begin
if procdef.proctypeoption<>potype_none then
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef._class) or
(procdef.procoptions*[po_classmethod, po_staticmethod,

2
compiler/i386/cgcpu.pas
View File

@ -529,7 +529,7 @@ unit cgcpu;
make_global : boolean;
href : treference;
begin
if procdef.proctypeoption<>potype_none then
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef._class) or
(procdef.procoptions*[po_classmethod, po_staticmethod,

4
compiler/pdecsub.pas
View File

@ -878,7 +878,7 @@ implementation
_FUNCTION :
begin
consume(_FUNCTION);
if parse_proc_head(aclass,potype_none,pd) then
if parse_proc_head(aclass,potype_function,pd) then
begin
{ pd=nil when it is a interface mapping }
if assigned(pd) then
@ -917,7 +917,7 @@ implementation
_PROCEDURE :
begin
consume(_PROCEDURE);
if parse_proc_head(aclass,potype_none,pd) then
if parse_proc_head(aclass,potype_procedure,pd) then
begin
{ pd=nil when it is a interface mapping }
if assigned(pd) then

6
compiler/powerpc/cgcpu.pas
View File

@ -1180,7 +1180,7 @@ const
{ compute start of gpr save area }
inc(href.offset,4);
end
else
else
{ compute start of gpr save area }
reference_reset_base(href,NR_R12,-4);
@ -1584,7 +1584,7 @@ const
const
macosLinkageAreaSize = 24;
var
var
href : treference;
registerSaveAreaSize : longint;
@ -2034,7 +2034,7 @@ const
var
make_global : boolean;
begin
if procdef.proctypeoption<>potype_none then
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef._class) or
(procdef.procoptions*[po_classmethod, po_staticmethod,

2
compiler/sparc/cgcpu.pas
View File

@ -1263,7 +1263,7 @@ implementation
make_global : boolean;
href : treference;
begin
if procdef.proctypeoption<>potype_none then
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef._class) or
(procdef.procoptions*[po_classmethod, po_staticmethod,

4
compiler/symconst.pas
View File

@ -219,7 +219,9 @@ type
potype_unitfinalize, { unit finalization }
potype_constructor, { Procedure is a constructor }
potype_destructor, { Procedure is a destructor }
potype_operator { Procedure defines an operator }
potype_operator, { Procedure defines an operator }
potype_procedure,
potype_function
);
tproctypeoptions=set of tproctypeoption;

41
compiler/utils/ppudump.pp
View File

@ -798,7 +798,7 @@ type
pocall_softfloat,
{ Metrowerks Pascal. Special case on Mac OS (X): passes all }
{ constant records by reference. }
pocall_mwpascal
pocall_mwpascal
);
tproccalloptions=set of tproccalloption;
tproctypeoption=(potype_none,
@ -807,7 +807,9 @@ type
potype_unitfinalize, { unit finalization }
potype_constructor, { Procedure is a constructor }
potype_destructor, { Procedure is a destructor }
potype_operator { Procedure defines an operator }
potype_operator, { Procedure defines an operator }
potype_procedure,
potype_function
);
tproctypeoptions=set of tproctypeoption;
tprocoption=(po_none,
@ -877,14 +879,16 @@ const
'SoftFloat',
'MWPascal'
);
proctypeopts=6;
proctypeopts=8;
proctypeopt : array[1..proctypeopts] of tproctypeopt=(
(mask:potype_proginit; str:'ProgInit'),
(mask:potype_unitinit; str:'UnitInit'),
(mask:potype_unitfinalize;str:'UnitFinalize'),
(mask:potype_constructor; str:'Constructor'),
(mask:potype_destructor; str:'Destructor'),
(mask:potype_operator; str:'Operator')
(mask:potype_operator; str:'Operator'),
(mask:potype_function; str:'Function'),
(mask:potype_procedure; str:'Procedure')
);
procopts=26;
procopt : array[1..procopts] of tprocopt=(
@ -925,21 +929,18 @@ begin
readtype;
writeln(space,' Fpu used : ',ppufile.getbyte);
proctypeoption:=tproctypeoption(ppufile.getbyte);
if proctypeoption<>potype_none then
begin
write(space,' TypeOption : ');
first:=true;
for i:=1 to proctypeopts do
if (proctypeopt[i].mask=proctypeoption) then
begin
if first then
first:=false
else
write(', ');
write(proctypeopt[i].str);
end;
writeln;
end;
write(space,' TypeOption : ');
first:=true;
for i:=1 to proctypeopts do
if (proctypeopt[i].mask=proctypeoption) then
begin
if first then
first:=false
else
write(', ');
write(proctypeopt[i].str);
end;
writeln;
proccalloption:=tproccalloption(ppufile.getbyte);
writeln(space,' CallOption : ',proccalloptionStr[proccalloption]);
ppufile.getsmallset(procoptions);
@ -1498,7 +1499,7 @@ begin
{ library symbol for AmigaOS/MorphOS }
write (space,' Library symbol : ');
readderef;
end;
end;
if (calloption=pocall_inline) then
begin
write (space,' FuncretSym : ');

2
compiler/x86_64/cgcpu.pas
View File

@ -90,7 +90,7 @@ unit cgcpu;
make_global : boolean;
href : treference;
begin
if procdef.proctypeoption<>potype_none then
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef._class) or
(procdef.procoptions*[po_classmethod, po_staticmethod,

21
tests/tbf/tb0175.pp Executable file
View File

@ -0,0 +1,21 @@
{$ifdef fpc}
{$Mode Delphi}
{$endif}
unit tb0175;
interface
function getvar: string;
implementation
var
myvar : string;
procedure getvar;
begin
result := myvar;
end;
end.