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