Certain Delphi constructs are not yet supported by the FreePascal
preprocessor. Therefore, I have written a patch to implement this
functionality, so the package Technetium can compile on FreePascal again.
The attached patch closes both these bugs:
http://www.freepascal.org/bugs/showrec.php3?ID=3683
http://www.freepascal.org/bugs/showrec.php3?ID=3691
If you accept this patch, please give credit as something like this:
"Patch by Christian Iversen to implement symbolic constants and the IN
operator in the preprocessor"
It seems that the real delphi uses a different approach to parsing expressions
in the preprocessor, so eventually this patch will be replaced. However, for
now, it helps many projects compile that otherwise wouldn't be able to.
--
Regards,
Christian Iversen
Index: scanner.pas
===================================================================
RCS file: /FPC/CVS/fpc/compiler/scanner.pas,v
retrieving revision 1.100
diff -u -3 -p -r1.100 scanner.pas
--- scanner.pas 14 Feb 2005 17:13:07 -0000 1.100
+++ scanner.pas 25 Feb 2005 15:59:00 -0000
@@ -191,7 +191,7 @@ implementation
cutils,
systems,
switches,
- symbase,symtable,symtype,symsym,symconst,
+ symbase,symtable,symtype,symsym,symconst,symdef,
fmodule;
var
@@ -628,8 +628,54 @@ implementation
else
begin
hs:=preproc_substitutedtoken;
+
+ if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then
+ begin
+ case srsym.typ of
+ constsym:
+ with tconstsym(srsym) do
+ begin
+ if consttyp = constord then
+ begin
+ if not assigned(consttype.def) then
+ begin
+ internalerror(2005022501);
+ exit;
+ end;
+ case consttype.def.deftype of
+ orddef:
+ begin
+ if torddef(consttype.def).typ in [u8bit,u16bit,u32bit,u64bit,
+ s8bit,s16bit,s32bit,s64bit,
+ bool8bit,bool16bit,bool32bit] then
+ str(value.valueord, read_factor)
+ else if torddef(consttype.def).typ = uchar then
+ read_factor := char(value.valueord)
+ else
+ read_factor := hs;
+ end;
+ enumdef:
+ begin
+ str(value.valueord, read_factor);
+ end;
+ else read_factor := hs;
+ end;
+ end else if consttyp = conststring then
+ read_factor := upper(pchar(value.valueordptr))
+ else
+ read_factor := hs;
+ end;
+ enumsym :
+ str(tenumsym(srsym).value, read_factor);
+ else
+ read_factor := hs;
+ end;
+ end
+ else
+ read_factor := hs; // Symbol not found
+
preproc_consume(_ID);
- read_factor:=hs;
+ current_scanner.skipspace;
end
end
else if current_scanner.preproc_token =_LKLAMMER then
@@ -638,6 +684,18 @@ implementation
read_factor:=read_expr;
preproc_consume(_RKLAMMER);
end
+ else if current_scanner.preproc_token = _LECKKLAMMER then
+ begin
+ preproc_consume(_LECKKLAMMER);
+ read_factor := ',';
+ while current_scanner.preproc_token = _ID do
+ begin
+ read_factor := read_factor+read_factor()+',';
+ if current_scanner.preproc_token = _COMMA then
+ preproc_consume(_COMMA);
+ end;
+ preproc_consume(_RECKKLAMMER);
+ end
else
Message(scan_e_error_in_preproc_expr);
end;
@@ -701,18 +759,24 @@ implementation
begin
hs1:=read_simple_expr;
t:=current_scanner.preproc_token;
- if not(t in [_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then
+ if (t = _ID) and (current_scanner.preproc_pattern = 'IN') then
+ t := _IN;
+ if not (t in [_IN,_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then
begin
read_expr:=hs1;
exit;
end;
- preproc_consume(t);
+ if (t = _IN) then
+ preproc_consume(_ID)
+ else
+ preproc_consume(t);
hs2:=read_simple_expr;
if is_number(hs1) and is_number(hs2) 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;
@@ -724,6 +788,10 @@ implementation
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;
@@ -3029,6 +3097,11 @@ exit_label:
current_scanner.preproc_pattern:=readval_asstring;
readpreproc:=_ID;
end;
+ ',' :
+ begin
+ readchar;
+ readpreproc:=_COMMA;
+ end;
'}' :
begin
readpreproc:=_END;
@@ -3042,6 +3115,16 @@ exit_label:
begin
readchar;
readpreproc:=_RKLAMMER;
+ end;
+ '[' :
+ begin
+ readchar;
+ readpreproc:=_LECKKLAMMER;
+ end;
+ ']' :
+ begin
+ readchar;
+ readpreproc:=_RECKKLAMMER;
end;
'+' :
begin
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
