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

* setting the compile mode should set the preprocessor symbol directly

Browse Source 
git-svn-id: trunk@1457 -
This commit is contained in:
peter 2005-10-18 06:57:39 +00:00
parent f622915690
commit 539b7dc220
5 changed files with 196 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5641,6 +5641,7 @@ tests/webtbf/tw4153.pp svneol=native#text/plain
tests/webtbf/tw4227.pp svneol=native#text/plain
tests/webtbf/tw4244.pp svneol=native#text/plain
tests/webtbf/tw4256.pp svneol=native#text/plain
tests/webtbf/tw4359.pp svneol=native#text/plain
tests/webtbf/tw4445.pp svneol=native#text/plain
tests/webtbf/uw0744.pp svneol=native#text/plain
tests/webtbf/uw0840a.pp svneol=native#text/plain

70
compiler/globals.pas
View File

@ -340,7 +340,6 @@ interface
procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
function is_number_float(d : double) : boolean;
Function SetCompileMode(const s:string; changeInit: boolean):boolean;
function SetAktProcCall(const s:string; changeInit: boolean):boolean;
function SetProcessor(const s:string; changeInit: boolean):boolean;
function SetFpuType(const s:string; changeInit: boolean):boolean;
@ -1830,75 +1829,6 @@ end;
end;
Function SetCompileMode(const s:string; changeInit: boolean):boolean;
var
b : boolean;
begin
b:=true;
if s='DEFAULT' then
aktmodeswitches:=initmodeswitches
else
if s='DELPHI' then
aktmodeswitches:=delphimodeswitches
else
if s='TP' then
aktmodeswitches:=tpmodeswitches
else
if s='FPC' then
aktmodeswitches:=fpcmodeswitches
else
if s='OBJFPC' then
aktmodeswitches:=objfpcmodeswitches
else
if s='GPC' then
aktmodeswitches:=gpcmodeswitches
else
if s='MACPAS' then
aktmodeswitches:=macmodeswitches
else
b:=false;
if b and changeInit then
initmodeswitches := aktmodeswitches;
if b then
begin
{ turn ansistrings on by default ? }
if (m_delphi in aktmodeswitches) then
begin
include(aktlocalswitches,cs_ansistrings);
if changeinit then
include(initlocalswitches,cs_ansistrings);
end
else
begin
exclude(aktlocalswitches,cs_ansistrings);
if changeinit then
exclude(initlocalswitches,cs_ansistrings);
end;
{ Default enum packing for delphi/tp7 }
if (m_tp7 in aktmodeswitches) or
(m_delphi in aktmodeswitches) or
(m_mac in aktmodeswitches) then
aktpackenum:=1
else
aktpackenum:=4;
if changeinit then
initpackenum:=aktpackenum;
{$ifdef i386}
{ Default to intel assembler for delphi/tp7 on i386 }
if (m_delphi in aktmodeswitches) or
(m_tp7 in aktmodeswitches) then
aktasmmode:=asmmode_i386_intel;
if changeinit then
initasmmode:=aktasmmode;
{$endif i386}
end;
SetCompileMode:=b;
end;
function SetAktProcCall(const s:string; changeInit:boolean):boolean;
const
DefProcCallName : array[tproccalloption] of string[12] = ('',

2
compiler/options.pas
View File

@ -78,7 +78,7 @@ uses
version,
cutils,cmsgs,
comphook,
symtable
symtable,scanner
{$ifdef BrowserLog}
,browlog
{$endif BrowserLog}

125
compiler/scanner.pas
View File

@ -184,6 +184,8 @@ interface
{To be called when the language mode is finally determined}
procedure ConsolidateMode;
Function SetCompileMode(const s:string; changeInit: boolean):boolean;
implementation
@ -247,8 +249,89 @@ implementation
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
macrosymtablestack:=current_module.globalmacrosymtable;
end;
end;
{ define a symbol in delphi,objfpc,tp,gpc,macpas mode }
Function SetCompileMode(const s:string; changeInit: boolean):boolean;
var
b : boolean;
oldaktmodeswitches : tmodeswitches;
begin
oldaktmodeswitches:=aktmodeswitches;
b:=true;
if s='DEFAULT' then
aktmodeswitches:=initmodeswitches
else
if s='DELPHI' then
aktmodeswitches:=delphimodeswitches
else
if s='TP' then
aktmodeswitches:=tpmodeswitches
else
if s='FPC' then
aktmodeswitches:=fpcmodeswitches
else
if s='OBJFPC' then
aktmodeswitches:=objfpcmodeswitches
else
if s='GPC' then
aktmodeswitches:=gpcmodeswitches
else
if s='MACPAS' then
aktmodeswitches:=macmodeswitches
else
b:=false;
if b and changeInit then
initmodeswitches := aktmodeswitches;
if b then
begin
{ turn ansistrings on by default ? }
if (m_delphi in aktmodeswitches) then
begin
include(aktlocalswitches,cs_ansistrings);
if changeinit then
include(initlocalswitches,cs_ansistrings);
end
else
begin
exclude(aktlocalswitches,cs_ansistrings);
if changeinit then
exclude(initlocalswitches,cs_ansistrings);
end;
{ Default enum packing for delphi/tp7 }
if (m_tp7 in aktmodeswitches) or
(m_delphi in aktmodeswitches) or
(m_mac in aktmodeswitches) then
aktpackenum:=1
else
aktpackenum:=4;
if changeinit then
initpackenum:=aktpackenum;
{$ifdef i386}
{ Default to intel assembler for delphi/tp7 on i386 }
if (m_delphi in aktmodeswitches) or
(m_tp7 in aktmodeswitches) then
aktasmmode:=asmmode_i386_intel;
if changeinit then
initasmmode:=aktasmmode;
{$endif i386}
{ Undefine old symbol }
if (m_delphi in oldaktmodeswitches) then
undef_system_macro('FPC_DELPHI')
else if (m_tp7 in oldaktmodeswitches) then
undef_system_macro('FPC_TP')
else if (m_objfpc in oldaktmodeswitches) then
undef_system_macro('FPC_OBJFPC')
else if (m_gpc in oldaktmodeswitches) then
undef_system_macro('FPC_GPC')
else if (m_mac in oldaktmodeswitches) then
undef_system_macro('FPC_MACPAS');
{ define new symbol in delphi,objfpc,tp,gpc,macpas mode }
if (m_delphi in aktmodeswitches) then
def_system_macro('FPC_DELPHI')
else if (m_tp7 in aktmodeswitches) then
@ -261,6 +344,8 @@ implementation
def_system_macro('FPC_MACPAS');
end;
SetCompileMode:=b;
end;
{*****************************************************************************
@ -525,7 +610,7 @@ compile time variables as the old format (0/1), continue to work.
break;
until false;
{At this point, result do contain the value. Do some decoding and
{ At this point, result do contain the value. Do some decoding and
determine the type.}
val(result,numres,w);
if (w=0) then {It is an integer}
@ -988,23 +1073,35 @@ compile time variables as the old format (0/1), continue to work.
val(hs1,l1,w);
val(hs2,l2,w);
case op of
_EQUAL : b:=l1=l2;
_UNEQUAL : b:=l1<>l2;
_LT : b:=l1<l2;
_GT : b:=l1>l2;
_GTE : b:=l1>=l2;
_LTE : b:=l1<=l2;
_EQUAL :
b:=l1=l2;
_UNEQUAL :
b:=l1<>l2;
_LT :
b:=l1<l2;
_GT :
b:=l1>l2;
_GTE :
b:=l1>=l2;
_LTE :
b:=l1<=l2;
end;
end
else
begin
case op of
_EQUAL : b:=hs1=hs2;
_UNEQUAL : b:=hs1<>hs2;
_LT : b:=hs1<hs2;
_GT : b:=hs1>hs2;
_GTE : b:=hs1>=hs2;
_LTE : b:=hs1<=hs2;
_EQUAL :
b:=hs1=hs2;
_UNEQUAL :
b:=hs1<>hs2;
_LT :
b:=hs1<hs2;
_GT :
b:=hs1>hs2;
_GTE :
b:=hs1>=hs2;
_LTE :
b:=hs1<=hs2;
end;
end;
end;

18
tests/webtbf/tw4359.pp Executable file
View File

@ -0,0 +1,18 @@
{ %fail }
{ %opt=-S2 }
{ Source provided for Free Pascal Bug Report 4359 }
{ Submitted by "Wolfgang Ehrhardt (via News, submitted by Marco)" on 2005-09-12 }
{ e-mail: Wolfgang.Ehrhardt@munich.netsurf.de }
{. mode objfpc}
program test;
{$ifdef FPC_OBJFPC}
{$fatal Correctly stopped at position 1} // not triggered by -S2, but is triggered by mode objfpc
{$endif}
var
bug: integer;
begin
end.