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

+ compile time expression type checking

Browse Source 
* fixed bug in $DEFINE under macpas

git-svn-id: trunk@919 -
This commit is contained in:
olle 2005-08-22 19:09:41 +00:00
parent d96231af45
commit e40c2fd8b0
4 changed files with 617 additions and 408 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/msg/errore.msg
View File

@ -309,8 +309,8 @@ scan_e_wrong_switch_toggle_default=02066_E_Wrong switch toggle, use ON/OFF/DEFAU
scan_e_mode_switch_not_allowed=02067_E_Mode switch "$1" not allowed here scan_e_mode_switch_not_allowed=02067_E_Mode switch "$1" not allowed here
% A mode switch has already been encountered, or, in case of option -Mmacpas, % A mode switch has already been encountered, or, in case of option -Mmacpas,
% a mode switch occur after UNIT. % a mode switch occur after UNIT.
scan_e_error_macro_undefined=02068_E_Compile time variable "$1" is not defined. scan_e_error_macro_undefined=02068_E_Compile time variable or macro "$1" is not defined.
% Thus the conditional compile time expression cannot be evaluated. % Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas.
scan_e_utf8_bigger_than_65535=02069_E_UTF-8 code greater than 65535 found scan_e_utf8_bigger_than_65535=02069_E_UTF-8 code greater than 65535 found
% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 % \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535
scan_e_utf8_malformed=02070_E_Malformed UTF-8 string scan_e_utf8_malformed=02070_E_Malformed UTF-8 string
@ -318,6 +318,8 @@ scan_e_utf8_malformed=02070_E_Malformed UTF-8 string
scan_c_switching_to_utf8=02071_C_UTF-8 signature found, using UTF-8 encoding scan_c_switching_to_utf8=02071_C_UTF-8 signature found, using UTF-8 encoding
% The compiler found an UTF-8 encoding signature ($ef, $bb, $bf) at the beginning of a file, % The compiler found an UTF-8 encoding signature ($ef, $bb, $bf) at the beginning of a file,
% so it interprets it as an UTF-8 file % so it interprets it as an UTF-8 file
scan_e_compile_time_typeerror=02072_E_Compile time expression: Wanted $1 but got $2 at $3
% Type check of a compile time expression failed.
% \end{description} % \end{description}
# #
# Parser # Parser

5
compiler/msgidx.inc
View File

@ -87,6 +87,7 @@ const
scan_e_utf8_bigger_than_65535=02069; scan_e_utf8_bigger_than_65535=02069;
scan_e_utf8_malformed=02070; scan_e_utf8_malformed=02070;
scan_c_switching_to_utf8=02071; scan_c_switching_to_utf8=02071;
scan_e_compile_time_typeerror=02072;
parser_e_syntax_error=03000; parser_e_syntax_error=03000;
parser_e_dont_nest_interrupt=03004; parser_e_dont_nest_interrupt=03004;
parser_w_proc_directive_ignored=03005; parser_w_proc_directive_ignored=03005;
@ -658,9 +659,9 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 38879; MsgTxtSize = 38948;
MsgIdxMax : array[1..20] of longint=( MsgIdxMax : array[1..20] of longint=(
19,72,215,59,59,46,100,20,135,60, 19,73,215,59,59,46,100,20,135,60,
40,1,1,1,1,1,1,1,1,1 40,1,1,1,1,1,1,1,1,1
); );

654
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

360
compiler/scanner.pas
View File

@ -387,9 +387,77 @@ implementation
setfilename(paramfn^, paramallowoutput); setfilename(paramfn^, paramallowoutput);
end; end;
function parse_compiler_expr:string; {
Compile time expression type check
----------------------------------
Each subexpression returns its type to the caller, which then can
do type check. Since data types of compile time expressions is
not well defined, the type system does a best effort. The drawback is
that some errors might not be detected.
function read_expr : string; forward; Instead of returning a particular data type, a set of possible data types
are returned. This way ambigouos types can be handled. For instance a
value of 1 can be both a boolean and and integer.
Booleans
--------
The following forms of boolean values are supported:
* C coded, that is 0 is false, non-zero is true.
* TRUE/FALSE for mac style compile time variables
Thus boolean mac compile time variables are always stored as TRUE/FALSE.
When a compile time expression is evaluated, they are then translated
to C coded booleans (0/1), to simplify for the expression evaluator.
Note that this scheme then also of support mac compile time variables which
are 0/1 but with a boolean meaning.
The TRUE/FALSE format is new from 22 august 2005, but the above scheme
means that units which is not recompiled, and thus stores
compile time variables as the old format (0/1), continue to work.
}
type
{Compile time expression types}
TCTEType = (ctetBoolean, ctetInteger, ctetString, ctetSet);
TCTETypeSet = set of TCTEType;
const
cteTypeNames : array[TCTEType] of string[10] = (
'BOOLEAN','INTEGER','STRING','SET');
{Subset of types which can be elements in sets.}
setElementTypes = [ctetBoolean, ctetInteger, ctetString];
function GetCTETypeName(t: TCTETypeSet): String;
var
i: TCTEType;
begin
result:= '';
for i:= Low(TCTEType) to High(TCTEType) do
if i in t then
if result = '' then
result:= cteTypeNames[i]
else
result:= result + ' or ' + cteTypeNames[i];
end;
procedure CTEError(actType, desiredExprType: TCTETypeSet; place: String);
begin
Message3(scan_e_compile_time_typeerror,
GetCTETypeName(desiredExprType),
GetCTETypeName(actType),
place
);
end;
function parse_compiler_expr(var compileExprType: TCTETypeSet):string;
function read_expr(var exprType: TCTETypeSet) : string; forward;
procedure preproc_consume(t : ttoken); procedure preproc_consume(t : ttoken);
begin begin
@ -398,14 +466,23 @@ implementation
current_scanner.preproc_token:=current_scanner.readpreproc; current_scanner.preproc_token:=current_scanner.readpreproc;
end; end;
function preproc_substitutedtoken: string; function preproc_substitutedtoken(var macroType: TCTETypeSet): string;
{ Currently this parses identifiers as well as numbers.
The result from this procedure can either be that the token
itself is a value, or that it is a compile time variable/macro,
which then is substituted for another value (for macros
recursivelly substituted).}
var var
hs: string; hs: string;
mac : tmacro; mac : tmacro;
macrocount, macrocount,
len : integer; len : integer;
numres : longint;
w: word;
begin begin
result := current_scanner.preproc_pattern; result := current_scanner.preproc_pattern;
mac:= nil;
{ Substitue macros and compiler variables with their content/value. { Substitue macros and compiler variables with their content/value.
For real macros also do recursive substitution. } For real macros also do recursive substitution. }
macrocount:=0; macrocount:=0;
@ -441,21 +518,47 @@ implementation
end end
else else
begin begin
(*
// To make this work, there must be some kind of type checking here...
if m_mac in aktmodeswitches then
Message1(scan_e_error_macro_undefined, result)
else
*)
break; break;
end; end;
if mac.is_compiler_var then if mac.is_compiler_var then
break; break;
until false; until false;
{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}
begin
if (numres = 0) or (numres = 1) then
macroType := [ctetInteger, ctetBoolean]
else
macroType := [ctetInteger];
end
else if assigned(mac) and (m_mac in aktmodeswitches) and (result='FALSE') then
begin
result:= '0';
macroType:= [ctetBoolean];
end
else if assigned(mac) and (m_mac in aktmodeswitches) and (result='TRUE') then
begin
result:= '1';
macroType:= [ctetBoolean];
end
else if (m_mac in aktmodeswitches) and
(not assigned(mac) or not mac.defined) and
(macrocount = 1) then
begin
{Errors in mode mac is issued here. For non macpas modes there is
more liberty, but the error will eventually be caught at a later stage.}
Message1(scan_e_error_macro_undefined, result);
macroType:= [ctetString]; {Just to have something}
end
else
macroType:= [ctetString];
end; end;
function read_factor : string; function read_factor(var factorType: TCTETypeSet) : string;
var var
hs : string; hs : string;
mac: tmacro; mac: tmacro;
@ -464,12 +567,14 @@ implementation
l : longint; l : longint;
w : integer; w : integer;
hasKlammer: Boolean; hasKlammer: Boolean;
setElemType : TCTETypeSet;
begin begin
if current_scanner.preproc_token=_ID then if current_scanner.preproc_token=_ID then
begin begin
if current_scanner.preproc_pattern='DEFINED' then if current_scanner.preproc_pattern='DEFINED' then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
current_scanner.skipspace; current_scanner.skipspace;
if current_scanner.preproc_token =_LKLAMMER then if current_scanner.preproc_token =_LKLAMMER then
@ -510,6 +615,7 @@ implementation
else else
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='UNDEFINED') then if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='UNDEFINED') then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
current_scanner.skipspace; current_scanner.skipspace;
if current_scanner.preproc_token =_ID then if current_scanner.preproc_token =_ID then
@ -533,6 +639,7 @@ implementation
else else
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='OPTION') then if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='OPTION') then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
current_scanner.skipspace; current_scanner.skipspace;
if current_scanner.preproc_token =_LKLAMMER then if current_scanner.preproc_token =_LKLAMMER then
@ -568,6 +675,7 @@ implementation
else else
if current_scanner.preproc_pattern='SIZEOF' then if current_scanner.preproc_pattern='SIZEOF' then
begin begin
factorType:= [ctetInteger];
preproc_consume(_ID); preproc_consume(_ID);
current_scanner.skipspace; current_scanner.skipspace;
if current_scanner.preproc_token =_LKLAMMER then if current_scanner.preproc_token =_LKLAMMER then
@ -607,6 +715,7 @@ implementation
else else
if current_scanner.preproc_pattern='DECLARED' then if current_scanner.preproc_pattern='DECLARED' then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
current_scanner.skipspace; current_scanner.skipspace;
if current_scanner.preproc_token =_LKLAMMER then if current_scanner.preproc_token =_LKLAMMER then
@ -637,8 +746,11 @@ implementation
else else
if current_scanner.preproc_pattern='NOT' then if current_scanner.preproc_pattern='NOT' then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
hs:=read_factor(); hs:=read_factor(factorType);
if not (ctetBoolean in factorType) then
CTEError(factorType, [ctetBoolean], 'NOT');
val(hs,l,w); val(hs,l,w);
if l<>0 then if l<>0 then
read_factor:='0' read_factor:='0'
@ -648,21 +760,24 @@ implementation
else else
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='TRUE') then if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='TRUE') then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
read_factor:='1'; read_factor:='1';
end end
else else
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='FALSE') then if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='FALSE') then
begin begin
factorType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
read_factor:='0'; read_factor:='0';
end end
else else
begin begin
hs:=preproc_substitutedtoken; hs:=preproc_substitutedtoken(factorType);
{ Default is to return the original symbol } { Default is to return the original symbol }
read_factor:=hs; read_factor:=hs;
if (m_delphi in aktmodeswitches) then if (m_delphi in aktmodeswitches) and (ctetString in factorType) then
if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then
begin begin
case srsym.typ of case srsym.typ of
@ -676,18 +791,34 @@ implementation
case consttype.def.deftype of case consttype.def.deftype of
orddef: orddef:
begin begin
if is_integer(consttype.def) or is_boolean(consttype.def) then if is_integer(consttype.def) then
read_factor:=tostr(value.valueord) begin
else read_factor:=tostr(value.valueord);
if is_char(consttype.def) then factorType:= [ctetInteger];
end
else if is_boolean(consttype.def) then
begin
read_factor:=tostr(value.valueord);
factorType:= [ctetBoolean];
end
else if is_char(consttype.def) then
begin
read_factor:=chr(value.valueord); read_factor:=chr(value.valueord);
factorType:= [ctetString];
end
end; end;
enumdef: enumdef:
read_factor:=tostr(value.valueord) begin
read_factor:=tostr(value.valueord);
factorType:= [ctetInteger];
end;
end; end;
end; end;
conststring : conststring :
read_factor := upper(pchar(value.valueptr)); begin
read_factor := upper(pchar(value.valueptr));
factorType:= [ctetString];
end;
constset : constset :
begin begin
hs:=','; hs:=',';
@ -695,15 +826,18 @@ implementation
if l in pconstset(tconstsym(srsym).value.valueptr)^ then if l in pconstset(tconstsym(srsym).value.valueptr)^ then
hs:=hs+tostr(l)+','; hs:=hs+tostr(l)+',';
read_factor := hs; read_factor := hs;
factorType:= [ctetSet];
end; end;
end; end;
end; end;
end; end;
enumsym : enumsym :
read_factor:=tostr(tenumsym(srsym).value); begin
read_factor:=tostr(tenumsym(srsym).value);
factorType:= [ctetInteger];
end;
end; end;
end; end;
preproc_consume(_ID); preproc_consume(_ID);
current_scanner.skipspace; current_scanner.skipspace;
end end
@ -711,7 +845,7 @@ implementation
else if current_scanner.preproc_token =_LKLAMMER then else if current_scanner.preproc_token =_LKLAMMER then
begin begin
preproc_consume(_LKLAMMER); preproc_consume(_LKLAMMER);
read_factor:=read_expr; read_factor:=read_expr(factorType);
preproc_consume(_RKLAMMER); preproc_consume(_RKLAMMER);
end end
else if current_scanner.preproc_token = _LECKKLAMMER then else if current_scanner.preproc_token = _LECKKLAMMER then
@ -720,30 +854,44 @@ implementation
read_factor := ','; read_factor := ',';
while current_scanner.preproc_token = _ID do while current_scanner.preproc_token = _ID do
begin begin
read_factor := read_factor+read_factor()+','; read_factor := read_factor+read_factor(setElemType)+',';
if current_scanner.preproc_token = _COMMA then if current_scanner.preproc_token = _COMMA then
preproc_consume(_COMMA); preproc_consume(_COMMA);
end; end;
// TODO Add check of setElemType
preproc_consume(_RECKKLAMMER); preproc_consume(_RECKKLAMMER);
factorType:= [ctetSet];
end end
else else
Message(scan_e_error_in_preproc_expr); Message(scan_e_error_in_preproc_expr);
end; end;
function read_term : string; function read_term(var termType: TCTETypeSet) : string;
var var
hs1,hs2 : string; hs1,hs2 : string;
l1,l2 : longint; l1,l2 : longint;
w : integer; w : integer;
termType2: TCTETypeSet;
begin begin
hs1:=read_factor; hs1:=read_factor(termType);
repeat repeat
if (current_scanner.preproc_token<>_ID) then if (current_scanner.preproc_token<>_ID) then
break; break;
if current_scanner.preproc_pattern<>'AND' then if current_scanner.preproc_pattern<>'AND' then
break; break;
{Check if first expr is boolean. Must be done here, after we know
it is an AND expression.}
if not (ctetBoolean in termType) then
CTEError(termType, [ctetBoolean], 'AND');
termType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
hs2:=read_factor; hs2:=read_factor(termType2);
if not (ctetBoolean in termType2) then
CTEError(termType2, [ctetBoolean], 'AND');
val(hs1,l1,w); val(hs1,l1,w);
val(hs2,l2,w); val(hs2,l2,w);
if (l1<>0) and (l2<>0) then if (l1<>0) and (l2<>0) then
@ -755,20 +903,32 @@ implementation
end; end;
function read_simple_expr : string; function read_simple_expr(var simpleExprType: TCTETypeSet) : string;
var var
hs1,hs2 : string; hs1,hs2 : string;
l1,l2 : longint; l1,l2 : longint;
w : integer; w : integer;
simpleExprType2: TCTETypeSet;
begin begin
hs1:=read_term; hs1:=read_term(simpleExprType);
repeat repeat
if (current_scanner.preproc_token<>_ID) then if (current_scanner.preproc_token<>_ID) then
break; break;
if current_scanner.preproc_pattern<>'OR' then if current_scanner.preproc_pattern<>'OR' then
break; break;
{Check if first expr is boolean. Must be done here, after we know
it is an OR expression.}
if not (ctetBoolean in simpleExprType) then
CTEError(simpleExprType, [ctetBoolean], 'OR');
simpleExprType:= [ctetBoolean];
preproc_consume(_ID); preproc_consume(_ID);
hs2:=read_term; hs2:=read_term(simpleExprType2);
if not (ctetBoolean in simpleExprType2) then
CTEError(simpleExprType2, [ctetBoolean], 'OR');
val(hs1,l1,w); val(hs1,l1,w);
val(hs2,l2,w); val(hs2,l2,w);
if (l1<>0) or (l2<>0) then if (l1<>0) or (l2<>0) then
@ -779,75 +939,97 @@ implementation
read_simple_expr:=hs1; read_simple_expr:=hs1;
end; end;
function read_expr : string; function read_expr(var exprType: TCTETypeSet) : string;
var var
hs1,hs2 : string; hs1,hs2 : string;
b : boolean; b : boolean;
t : ttoken; op : ttoken;
w : integer; w : integer;
l1,l2 : longint; l1,l2 : longint;
exprType2: TCTETypeSet;
begin begin
hs1:=read_simple_expr; hs1:=read_simple_expr(exprType);
t:=current_scanner.preproc_token; op:=current_scanner.preproc_token;
if (t = _ID) and (current_scanner.preproc_pattern = 'IN') then if (op = _ID) and (current_scanner.preproc_pattern = 'IN') then
t := _IN; op := _IN;
if not (t in [_IN,_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then if not (op in [_IN,_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then
begin begin
read_expr:=hs1; read_expr:=hs1;
exit; exit;
end; end;
if (t = _IN) then
if (op = _IN) then
preproc_consume(_ID) preproc_consume(_ID)
else else
preproc_consume(t); preproc_consume(op);
hs2:=read_simple_expr; hs2:=read_simple_expr(exprType2);
if is_number(hs1) and is_number(hs2) then
if op = _IN then
begin begin
val(hs1,l1,w); if exprType2 <> [ctetSet] then
val(hs2,l2,w); CTEError(exprType2, [ctetSet], 'IN');
case t of if exprType = [ctetSet] then
_IN : Message(scan_e_preproc_syntax_error); CTEError(exprType, setElementTypes, 'IN');
_EQUAL : b:=l1=l2;
_UNEQUAL : b:=l1<>l2; if is_number(hs1) and is_number(hs2) then
_LT : b:=l1<l2; Message(scan_e_preproc_syntax_error)
_GT : b:=l1>l2; else if hs2[1] = ',' then
_GTE : b:=l1>=l2; b:=pos(','+hs1+',', hs2) > 0 { TODO For integer sets, perhaps check for numeric equivalence so that 0 = 00 }
_LTE : b:=l1<=l2; else
end; Message(scan_e_preproc_syntax_error);
end end
else else
begin begin
case t of if (exprType * exprType2) = [] then
_IN : if hs2[1] = ',' then CTEError(exprType2, exprType, tokeninfo^[op].str);
b:=pos(','+hs1+',', hs2) > 0
else if is_number(hs1) and is_number(hs2) then
Message(scan_e_preproc_syntax_error); begin
_EQUAL : b:=hs1=hs2; val(hs1,l1,w);
_UNEQUAL : b:=hs1<>hs2; val(hs2,l2,w);
_LT : b:=hs1<hs2; case op of
_GT : b:=hs1>hs2; _EQUAL : b:=l1=l2;
_GTE : b:=hs1>=hs2; _UNEQUAL : b:=l1<>l2;
_LTE : b:=hs1<=hs2; _LT : b:=l1<l2;
end; _GT : b:=l1>l2;
end; _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;
end;
end;
end;
if b then if b then
read_expr:='1' read_expr:='1'
else else
read_expr:='0'; read_expr:='0';
exprType:= [ctetBoolean];
end; end;
begin begin
current_scanner.skipspace; current_scanner.skipspace;
{ start preproc expression scanner } { start preproc expression scanner }
current_scanner.preproc_token:=current_scanner.readpreproc; current_scanner.preproc_token:=current_scanner.readpreproc;
parse_compiler_expr:=read_expr; parse_compiler_expr:=read_expr(compileExprType);
end; end;
function boolean_compile_time_expr(var valuedescr: String): Boolean; function boolean_compile_time_expr(var valuedescr: String): Boolean;
var var
hs : string; hs : string;
exprType: TCTETypeSet;
begin begin
hs:=parse_compiler_expr; hs:=parse_compiler_expr(exprType);
if (exprType * [ctetBoolean]) = [] then
CTEError(exprType, [ctetBoolean], 'IF or ELSEIF');
boolean_compile_time_expr:= hs <> '0'; boolean_compile_time_expr:= hs <> '0';
valuedescr:= hs; valuedescr:= hs;
end; end;
@ -862,7 +1044,7 @@ implementation
current_scanner.elseifpreprocstack(@boolean_compile_time_expr); current_scanner.elseifpreprocstack(@boolean_compile_time_expr);
end; end;
procedure dir_define; procedure dir_define_impl(macstyle: boolean);
var var
hs : string; hs : string;
bracketcount : longint; bracketcount : longint;
@ -898,7 +1080,7 @@ implementation
{ !!!!!! handle macro params, need we this? } { !!!!!! handle macro params, need we this? }
current_scanner.skipspace; current_scanner.skipspace;
if not (m_mac in aktmodeswitches) then if not macstyle then
begin begin
{ may be a macro? } { may be a macro? }
if c <> ':' then if c <> ':' then
@ -964,10 +1146,23 @@ implementation
end; end;
end; end;
procedure dir_define;
begin
dir_define_impl(false);
end;
procedure dir_definec;
begin
dir_define_impl(true);
end;
procedure dir_setc; procedure dir_setc;
var var
hs : string; hs : string;
mac : tmacro; mac : tmacro;
exprType: TCTETypeSet;
l : longint;
w : integer;
begin begin
current_scanner.skipspace; current_scanner.skipspace;
hs:=current_scanner.readid; hs:=current_scanner.readid;
@ -1008,9 +1203,22 @@ implementation
if c='=' then if c='=' then
begin begin
current_scanner.readchar; current_scanner.readchar;
hs:= parse_compiler_expr; hs:= parse_compiler_expr(exprType);
if (exprType * [ctetBoolean, ctetInteger]) = [] then
CTEError(exprType, [ctetBoolean, ctetInteger], 'SETC');
if length(hs) <> 0 then if length(hs) <> 0 then
begin begin
{If we are absolutely shure it is boolean, translate
to TRUE/FALSE to increase possibility to do future type check}
if exprType = [ctetBoolean] then
begin
val(hs,l,w);
if l<>0 then
hs:='TRUE'
else
hs:='FALSE';
end;
Message2(parser_c_macro_set_to,mac.name,hs); Message2(parser_c_macro_set_to,mac.name,hs);
{ free buffer of macro ?} { free buffer of macro ?}
if assigned(mac.buftext) then if assigned(mac.buftext) then
@ -1067,13 +1275,13 @@ implementation
hpath : string; hpath : string;
begin begin
{ look for the include file (* look for the include file
If path was specified as part of {$I } then If path was specified as part of {$I } then
1. specified path (expanded with path of inputfile if relative) 1. specified path (expanded with path of inputfile if relative)
else else
1. path of current inputfile,current dir 1. path of current inputfile,current dir
2. local includepath 2. local includepath
3. global includepath } 3. global includepath *)
found:=false; found:=false;
foundfile:=''; foundfile:='';
hpath:=''; hpath:='';
@ -1695,8 +1903,6 @@ implementation
end; end;
procedure tscannerfile.elsepreprocstack; procedure tscannerfile.elsepreprocstack;
var
valuedescr: String;
begin begin
if assigned(preprocstack) and if assigned(preprocstack) and
(preprocstack.typ<>pp_else) then (preprocstack.typ<>pp_else) then
@ -3436,7 +3642,7 @@ exit_label:
{ Directives and conditionals for mode macpas: } { Directives and conditionals for mode macpas: }
AddDirective('SETC',directive_mac, @dir_setc); AddDirective('SETC',directive_mac, @dir_setc);
AddDirective('DEFINEC',directive_mac, @dir_define); AddDirective('DEFINEC',directive_mac, @dir_definec);
AddDirective('UNDEFC',directive_mac, @dir_undef); AddDirective('UNDEFC',directive_mac, @dir_undef);
AddConditional('IFC',directive_mac, @dir_if); AddConditional('IFC',directive_mac, @dir_if);