mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 18:47:52 +02:00
+ compile time expression type checking
* fixed bug in $DEFINE under macpas git-svn-id: trunk@919 -
This commit is contained in:
olle
parent
d96231af45
commit
e40c2fd8b0
@ -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
|
||||
% A mode switch has already been encountered, or, in case of option -Mmacpas,
|
||||
% a mode switch occur after UNIT.
|
||||
scan_e_error_macro_undefined=02068_E_Compile time variable "$1" is not defined.
|
||||
% Thus the conditional compile time expression cannot be evaluated.
|
||||
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. Only in mode MacPas.
|
||||
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
|
||||
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
|
||||
% 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
|
||||
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}
|
||||
#
|
||||
# Parser
|
||||
|
||||
@ -87,6 +87,7 @@ const
|
||||
scan_e_utf8_bigger_than_65535=02069;
|
||||
scan_e_utf8_malformed=02070;
|
||||
scan_c_switching_to_utf8=02071;
|
||||
scan_e_compile_time_typeerror=02072;
|
||||
parser_e_syntax_error=03000;
|
||||
parser_e_dont_nest_interrupt=03004;
|
||||
parser_w_proc_directive_ignored=03005;
|
||||
@ -658,9 +659,9 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 38879;
|
||||
MsgTxtSize = 38948;
|
||||
|
||||
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
|
||||
);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -387,9 +387,77 @@ implementation
|
||||
setfilename(paramfn^, paramallowoutput);
|
||||
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);
|
||||
begin
|
||||
@ -398,14 +466,23 @@ implementation
|
||||
current_scanner.preproc_token:=current_scanner.readpreproc;
|
||||
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
|
||||
hs: string;
|
||||
mac : tmacro;
|
||||
macrocount,
|
||||
len : integer;
|
||||
numres : longint;
|
||||
w: word;
|
||||
begin
|
||||
result := current_scanner.preproc_pattern;
|
||||
mac:= nil;
|
||||
{ Substitue macros and compiler variables with their content/value.
|
||||
For real macros also do recursive substitution. }
|
||||
macrocount:=0;
|
||||
@ -441,21 +518,47 @@ implementation
|
||||
end
|
||||
else
|
||||
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;
|
||||
end;
|
||||
|
||||
if mac.is_compiler_var then
|
||||
break;
|
||||
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;
|
||||
|
||||
function read_factor : string;
|
||||
function read_factor(var factorType: TCTETypeSet) : string;
|
||||
var
|
||||
hs : string;
|
||||
mac: tmacro;
|
||||
@ -464,12 +567,14 @@ implementation
|
||||
l : longint;
|
||||
w : integer;
|
||||
hasKlammer: Boolean;
|
||||
setElemType : TCTETypeSet;
|
||||
|
||||
begin
|
||||
if current_scanner.preproc_token=_ID then
|
||||
begin
|
||||
if current_scanner.preproc_pattern='DEFINED' then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
current_scanner.skipspace;
|
||||
if current_scanner.preproc_token =_LKLAMMER then
|
||||
@ -510,6 +615,7 @@ implementation
|
||||
else
|
||||
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='UNDEFINED') then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
current_scanner.skipspace;
|
||||
if current_scanner.preproc_token =_ID then
|
||||
@ -533,6 +639,7 @@ implementation
|
||||
else
|
||||
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='OPTION') then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
current_scanner.skipspace;
|
||||
if current_scanner.preproc_token =_LKLAMMER then
|
||||
@ -568,6 +675,7 @@ implementation
|
||||
else
|
||||
if current_scanner.preproc_pattern='SIZEOF' then
|
||||
begin
|
||||
factorType:= [ctetInteger];
|
||||
preproc_consume(_ID);
|
||||
current_scanner.skipspace;
|
||||
if current_scanner.preproc_token =_LKLAMMER then
|
||||
@ -607,6 +715,7 @@ implementation
|
||||
else
|
||||
if current_scanner.preproc_pattern='DECLARED' then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
current_scanner.skipspace;
|
||||
if current_scanner.preproc_token =_LKLAMMER then
|
||||
@ -637,8 +746,11 @@ implementation
|
||||
else
|
||||
if current_scanner.preproc_pattern='NOT' then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
hs:=read_factor();
|
||||
hs:=read_factor(factorType);
|
||||
if not (ctetBoolean in factorType) then
|
||||
CTEError(factorType, [ctetBoolean], 'NOT');
|
||||
val(hs,l,w);
|
||||
if l<>0 then
|
||||
read_factor:='0'
|
||||
@ -648,21 +760,24 @@ implementation
|
||||
else
|
||||
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='TRUE') then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
read_factor:='1';
|
||||
end
|
||||
else
|
||||
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='FALSE') then
|
||||
begin
|
||||
factorType:= [ctetBoolean];
|
||||
preproc_consume(_ID);
|
||||
read_factor:='0';
|
||||
end
|
||||
else
|
||||
begin
|
||||
hs:=preproc_substitutedtoken;
|
||||
hs:=preproc_substitutedtoken(factorType);
|
||||
|
||||
{ Default is to return the original symbol }
|
||||
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
|
||||
begin
|
||||
case srsym.typ of
|
||||
@ -676,18 +791,34 @@ implementation
|
||||
case consttype.def.deftype of
|
||||
orddef:
|
||||
begin
|
||||
if is_integer(consttype.def) or is_boolean(consttype.def) then
|
||||
read_factor:=tostr(value.valueord)
|
||||
else
|
||||
if is_char(consttype.def) then
|
||||
if is_integer(consttype.def) then
|
||||
begin
|
||||
read_factor:=tostr(value.valueord);
|
||||
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);
|
||||
factorType:= [ctetString];
|
||||
end
|
||||
end;
|
||||
enumdef:
|
||||
read_factor:=tostr(value.valueord)
|
||||
begin
|
||||
read_factor:=tostr(value.valueord);
|
||||
factorType:= [ctetInteger];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
conststring :
|
||||
read_factor := upper(pchar(value.valueptr));
|
||||
begin
|
||||
read_factor := upper(pchar(value.valueptr));
|
||||
factorType:= [ctetString];
|
||||
end;
|
||||
constset :
|
||||
begin
|
||||
hs:=',';
|
||||
@ -695,15 +826,18 @@ implementation
|
||||
if l in pconstset(tconstsym(srsym).value.valueptr)^ then
|
||||
hs:=hs+tostr(l)+',';
|
||||
read_factor := hs;
|
||||
factorType:= [ctetSet];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
enumsym :
|
||||
read_factor:=tostr(tenumsym(srsym).value);
|
||||
begin
|
||||
read_factor:=tostr(tenumsym(srsym).value);
|
||||
factorType:= [ctetInteger];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
preproc_consume(_ID);
|
||||
current_scanner.skipspace;
|
||||
end
|
||||
@ -711,7 +845,7 @@ implementation
|
||||
else if current_scanner.preproc_token =_LKLAMMER then
|
||||
begin
|
||||
preproc_consume(_LKLAMMER);
|
||||
read_factor:=read_expr;
|
||||
read_factor:=read_expr(factorType);
|
||||
preproc_consume(_RKLAMMER);
|
||||
end
|
||||
else if current_scanner.preproc_token = _LECKKLAMMER then
|
||||
@ -720,30 +854,44 @@ implementation
|
||||
read_factor := ',';
|
||||
while current_scanner.preproc_token = _ID do
|
||||
begin
|
||||
read_factor := read_factor+read_factor()+',';
|
||||
read_factor := read_factor+read_factor(setElemType)+',';
|
||||
if current_scanner.preproc_token = _COMMA then
|
||||
preproc_consume(_COMMA);
|
||||
end;
|
||||
// TODO Add check of setElemType
|
||||
preproc_consume(_RECKKLAMMER);
|
||||
factorType:= [ctetSet];
|
||||
end
|
||||
else
|
||||
Message(scan_e_error_in_preproc_expr);
|
||||
end;
|
||||
|
||||
function read_term : string;
|
||||
function read_term(var termType: TCTETypeSet) : string;
|
||||
var
|
||||
hs1,hs2 : string;
|
||||
l1,l2 : longint;
|
||||
w : integer;
|
||||
termType2: TCTETypeSet;
|
||||
begin
|
||||
hs1:=read_factor;
|
||||
hs1:=read_factor(termType);
|
||||
repeat
|
||||
if (current_scanner.preproc_token<>_ID) then
|
||||
break;
|
||||
if current_scanner.preproc_pattern<>'AND' then
|
||||
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);
|
||||
hs2:=read_factor;
|
||||
hs2:=read_factor(termType2);
|
||||
|
||||
if not (ctetBoolean in termType2) then
|
||||
CTEError(termType2, [ctetBoolean], 'AND');
|
||||
|
||||
val(hs1,l1,w);
|
||||
val(hs2,l2,w);
|
||||
if (l1<>0) and (l2<>0) then
|
||||
@ -755,20 +903,32 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function read_simple_expr : string;
|
||||
function read_simple_expr(var simpleExprType: TCTETypeSet) : string;
|
||||
var
|
||||
hs1,hs2 : string;
|
||||
l1,l2 : longint;
|
||||
w : integer;
|
||||
simpleExprType2: TCTETypeSet;
|
||||
begin
|
||||
hs1:=read_term;
|
||||
hs1:=read_term(simpleExprType);
|
||||
repeat
|
||||
if (current_scanner.preproc_token<>_ID) then
|
||||
break;
|
||||
if current_scanner.preproc_pattern<>'OR' then
|
||||
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);
|
||||
hs2:=read_term;
|
||||
hs2:=read_term(simpleExprType2);
|
||||
|
||||
if not (ctetBoolean in simpleExprType2) then
|
||||
CTEError(simpleExprType2, [ctetBoolean], 'OR');
|
||||
|
||||
val(hs1,l1,w);
|
||||
val(hs2,l2,w);
|
||||
if (l1<>0) or (l2<>0) then
|
||||
@ -779,75 +939,97 @@ implementation
|
||||
read_simple_expr:=hs1;
|
||||
end;
|
||||
|
||||
function read_expr : string;
|
||||
function read_expr(var exprType: TCTETypeSet) : string;
|
||||
var
|
||||
hs1,hs2 : string;
|
||||
b : boolean;
|
||||
t : ttoken;
|
||||
op : ttoken;
|
||||
w : integer;
|
||||
l1,l2 : longint;
|
||||
exprType2: TCTETypeSet;
|
||||
begin
|
||||
hs1:=read_simple_expr;
|
||||
t:=current_scanner.preproc_token;
|
||||
if (t = _ID) and (current_scanner.preproc_pattern = 'IN') then
|
||||
t := _IN;
|
||||
if not (t in [_IN,_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then
|
||||
hs1:=read_simple_expr(exprType);
|
||||
op:=current_scanner.preproc_token;
|
||||
if (op = _ID) and (current_scanner.preproc_pattern = 'IN') then
|
||||
op := _IN;
|
||||
if not (op in [_IN,_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then
|
||||
begin
|
||||
read_expr:=hs1;
|
||||
exit;
|
||||
end;
|
||||
if (t = _IN) then
|
||||
|
||||
if (op = _IN) then
|
||||
preproc_consume(_ID)
|
||||
else
|
||||
preproc_consume(t);
|
||||
hs2:=read_simple_expr;
|
||||
if is_number(hs1) and is_number(hs2) then
|
||||
preproc_consume(op);
|
||||
hs2:=read_simple_expr(exprType2);
|
||||
|
||||
if op = _IN then
|
||||
begin
|
||||
val(hs1,l1,w);
|
||||
val(hs2,l2,w);
|
||||
case t of
|
||||
_IN : Message(scan_e_preproc_syntax_error);
|
||||
_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;
|
||||
if exprType2 <> [ctetSet] then
|
||||
CTEError(exprType2, [ctetSet], 'IN');
|
||||
if exprType = [ctetSet] then
|
||||
CTEError(exprType, setElementTypes, 'IN');
|
||||
|
||||
if is_number(hs1) and is_number(hs2) then
|
||||
Message(scan_e_preproc_syntax_error)
|
||||
else if hs2[1] = ',' then
|
||||
b:=pos(','+hs1+',', hs2) > 0 { TODO For integer sets, perhaps check for numeric equivalence so that 0 = 00 }
|
||||
else
|
||||
Message(scan_e_preproc_syntax_error);
|
||||
end
|
||||
else
|
||||
begin
|
||||
case t of
|
||||
_IN : if hs2[1] = ',' then
|
||||
b:=pos(','+hs1+',', hs2) > 0
|
||||
else
|
||||
Message(scan_e_preproc_syntax_error);
|
||||
_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;
|
||||
begin
|
||||
if (exprType * exprType2) = [] then
|
||||
CTEError(exprType2, exprType, tokeninfo^[op].str);
|
||||
|
||||
if is_number(hs1) and is_number(hs2) then
|
||||
begin
|
||||
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;
|
||||
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
|
||||
read_expr:='1'
|
||||
else
|
||||
read_expr:='0';
|
||||
exprType:= [ctetBoolean];
|
||||
end;
|
||||
|
||||
begin
|
||||
current_scanner.skipspace;
|
||||
{ start preproc expression scanner }
|
||||
current_scanner.preproc_token:=current_scanner.readpreproc;
|
||||
parse_compiler_expr:=read_expr;
|
||||
end;
|
||||
parse_compiler_expr:=read_expr(compileExprType);
|
||||
end;
|
||||
|
||||
function boolean_compile_time_expr(var valuedescr: String): Boolean;
|
||||
var
|
||||
hs : string;
|
||||
exprType: TCTETypeSet;
|
||||
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';
|
||||
valuedescr:= hs;
|
||||
end;
|
||||
@ -862,7 +1044,7 @@ implementation
|
||||
current_scanner.elseifpreprocstack(@boolean_compile_time_expr);
|
||||
end;
|
||||
|
||||
procedure dir_define;
|
||||
procedure dir_define_impl(macstyle: boolean);
|
||||
var
|
||||
hs : string;
|
||||
bracketcount : longint;
|
||||
@ -898,7 +1080,7 @@ implementation
|
||||
{ !!!!!! handle macro params, need we this? }
|
||||
current_scanner.skipspace;
|
||||
|
||||
if not (m_mac in aktmodeswitches) then
|
||||
if not macstyle then
|
||||
begin
|
||||
{ may be a macro? }
|
||||
if c <> ':' then
|
||||
@ -964,10 +1146,23 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure dir_define;
|
||||
begin
|
||||
dir_define_impl(false);
|
||||
end;
|
||||
|
||||
procedure dir_definec;
|
||||
begin
|
||||
dir_define_impl(true);
|
||||
end;
|
||||
|
||||
procedure dir_setc;
|
||||
var
|
||||
hs : string;
|
||||
mac : tmacro;
|
||||
exprType: TCTETypeSet;
|
||||
l : longint;
|
||||
w : integer;
|
||||
begin
|
||||
current_scanner.skipspace;
|
||||
hs:=current_scanner.readid;
|
||||
@ -1008,9 +1203,22 @@ implementation
|
||||
if c='=' then
|
||||
begin
|
||||
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
|
||||
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);
|
||||
{ free buffer of macro ?}
|
||||
if assigned(mac.buftext) then
|
||||
@ -1067,13 +1275,13 @@ implementation
|
||||
hpath : string;
|
||||
|
||||
begin
|
||||
{ look for the include file
|
||||
(* look for the include file
|
||||
If path was specified as part of {$I } then
|
||||
1. specified path (expanded with path of inputfile if relative)
|
||||
else
|
||||
1. path of current inputfile,current dir
|
||||
2. local includepath
|
||||
3. global includepath }
|
||||
3. global includepath *)
|
||||
found:=false;
|
||||
foundfile:='';
|
||||
hpath:='';
|
||||
@ -1695,8 +1903,6 @@ implementation
|
||||
end;
|
||||
|
||||
procedure tscannerfile.elsepreprocstack;
|
||||
var
|
||||
valuedescr: String;
|
||||
begin
|
||||
if assigned(preprocstack) and
|
||||
(preprocstack.typ<>pp_else) then
|
||||
@ -3436,7 +3642,7 @@ exit_label:
|
||||
|
||||
{ Directives and conditionals for mode macpas: }
|
||||
AddDirective('SETC',directive_mac, @dir_setc);
|
||||
AddDirective('DEFINEC',directive_mac, @dir_define);
|
||||
AddDirective('DEFINEC',directive_mac, @dir_definec);
|
||||
AddDirective('UNDEFC',directive_mac, @dir_undef);
|
||||
|
||||
AddConditional('IFC',directive_mac, @dir_if);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user