diff --git a/.gitattributes b/.gitattributes
index 5355e18e4b..817f7abe40 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -3473,6 +3473,7 @@ packages/fcl-web/src/restbridge/sqldbrestdata.pp svneol=native#text/plain
packages/fcl-web/src/restbridge/sqldbrestini.pp svneol=native#text/plain
packages/fcl-web/src/restbridge/sqldbrestio.pp svneol=native#text/plain
packages/fcl-web/src/restbridge/sqldbrestjson.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestmodule.pp svneol=native#text/plain
packages/fcl-web/src/restbridge/sqldbrestschema.pp svneol=native#text/plain
packages/fcl-web/src/restbridge/sqldbrestxml.pp svneol=native#text/plain
packages/fcl-web/src/webdata/Makefile svneol=native#text/plain
@@ -7616,6 +7617,7 @@ packages/rtl-objpas/Makefile.fpc svneol=native#text/plain
packages/rtl-objpas/Makefile.fpc.fpcmake svneol=native#text/plain
packages/rtl-objpas/fpmake.pp svneol=native#text/plain
packages/rtl-objpas/src/common/varutils.pp svneol=native#text/plain
+packages/rtl-objpas/src/i386/invoke.inc svneol=native#text/pascal
packages/rtl-objpas/src/inc/convutil.inc svneol=native#text/plain
packages/rtl-objpas/src/inc/convutil.pp svneol=native#text/plain
packages/rtl-objpas/src/inc/convutils.pp svneol=native#text/plain
@@ -14811,6 +14813,7 @@ tests/webtbf/tw34821.pp svneol=native#text/plain
tests/webtbf/tw3488.pp svneol=native#text/plain
tests/webtbf/tw3495.pp svneol=native#text/plain
tests/webtbf/tw3502.pp svneol=native#text/plain
+tests/webtbf/tw35149a.pp svneol=native#text/plain
tests/webtbf/tw3553.pp svneol=native#text/plain
tests/webtbf/tw3562.pp svneol=native#text/plain
tests/webtbf/tw3583.pp svneol=native#text/plain
@@ -16542,6 +16545,7 @@ tests/webtbs/tw3504.pp svneol=native#text/plain
tests/webtbs/tw3506.pp svneol=native#text/plain
tests/webtbs/tw35139.pp svneol=native#text/plain
tests/webtbs/tw35139a.pp svneol=native#text/plain
+tests/webtbs/tw35149.pp svneol=native#text/plain
tests/webtbs/tw3523.pp svneol=native#text/plain
tests/webtbs/tw3529.pp svneol=native#text/plain
tests/webtbs/tw3531.pp svneol=native#text/plain
diff --git a/compiler/Makefile b/compiler/Makefile
index b1109f9738..50c7b54c99 100644
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -545,6 +545,9 @@ endif
ifeq ($(PPC_TARGET),arm)
override LOCALOPT+=-Fuarmgen
endif
+ifeq ($(PPC_TARGET),armeb)
+override LOCALOPT+=-Fuarmgen
+endif
ifeq ($(PPC_TARGET),mipsel)
override LOCALOPT+=-Fumips
endif
diff --git a/compiler/Makefile.fpc b/compiler/Makefile.fpc
index e0ab722455..98e4037252 100644
--- a/compiler/Makefile.fpc
+++ b/compiler/Makefile.fpc
@@ -312,6 +312,11 @@ ifeq ($(PPC_TARGET),arm)
override LOCALOPT+=-Fuarmgen
endif
+# ARMEB specific
+ifeq ($(PPC_TARGET),armeb)
+override LOCALOPT+=-Fuarmgen
+endif
+
# mipsel specific
ifeq ($(PPC_TARGET),mipsel)
override LOCALOPT+=-Fumips
diff --git a/compiler/arm/narmld.pas b/compiler/arm/narmld.pas
index 2ec3dee1f8..bba98a2bff 100644
--- a/compiler/arm/narmld.pas
+++ b/compiler/arm/narmld.pas
@@ -55,8 +55,6 @@ implementation
procedure tarmloadnode.generate_threadvar_access(gvs: tstaticvarsym);
var
- paraloc1 : tcgpara;
- pd: tprocdef;
href: treference;
hregister : tregister;
handled: boolean;
diff --git a/compiler/cclasses.pas b/compiler/cclasses.pas
index 4dfda17983..e12cb19263 100644
--- a/compiler/cclasses.pas
+++ b/compiler/cclasses.pas
@@ -422,9 +422,9 @@ type
{ true if string is in the container }
function Find(const s:TCmdStr):TCmdStrListItem;
{ inserts an item }
- procedure InsertItem(item:TCmdStrListItem); {$ifdef CCLASSESINLINE}inline;{$endif}
+ procedure InsertItem(item:TCmdStrListItem);
{ concats an item }
- procedure ConcatItem(item:TCmdStrListItem); {$ifdef CCLASSESINLINE}inline;{$endif}
+ procedure ConcatItem(item:TCmdStrListItem);
property Doubles:boolean read FDoubles write FDoubles;
end;
diff --git a/compiler/hlcg2ll.pas b/compiler/hlcg2ll.pas
index 5f8e83777a..2100e09acf 100644
--- a/compiler/hlcg2ll.pas
+++ b/compiler/hlcg2ll.pas
@@ -1550,7 +1550,7 @@ implementation
{$else cpu64bitalu}
{ use cg64 only for int64, not for 8 byte records; in particular,
filter out records passed in fpu/mm register}
- if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) and (cgpara.location^.loc=LOC_REGISTER) then
+ if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) and (cgpara.location^.loc in [LOC_REGISTER,LOC_REFERENCE]) then
cg64.a_load64_loc_cgpara(list,l,cgpara)
else
{$endif cpu64bitalu}
diff --git a/compiler/i386/aoptcpu.pas b/compiler/i386/aoptcpu.pas
index c401577e2a..79758a6e16 100644
--- a/compiler/i386/aoptcpu.pas
+++ b/compiler/i386/aoptcpu.pas
@@ -131,7 +131,6 @@ function WriteOk : Boolean;
end;
var
- l : longint;
p,hp1,hp2 : tai;
hp3,hp4: tai;
v:aint;
diff --git a/compiler/i386/cgcpu.pas b/compiler/i386/cgcpu.pas
index 51ecdb7bd4..774ae92cd1 100644
--- a/compiler/i386/cgcpu.pas
+++ b/compiler/i386/cgcpu.pas
@@ -261,10 +261,6 @@ unit cgcpu;
reference_reset_symbol(tmpref,dirref.symbol,0,sizeof(pint),[]);
tmpref.refaddr:=addr_pic;
tmpref.base:=current_procinfo.got;
-{$ifdef EXTDEBUG}
- if not (pi_needs_got in current_procinfo.flags) then
- Comment(V_warning,'pi_needs_got not included');
-{$endif EXTDEBUG}
include(current_procinfo.flags,pi_needs_got);
list.concat(taicpu.op_ref(A_PUSH,S_L,tmpref));
end
@@ -549,7 +545,10 @@ unit cgcpu;
if not (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then
begin
{ Use ECX as a temp register by default }
- tmpreg:=NR_ECX;
+ if current_procinfo.got = NR_EBX then
+ tmpreg:=NR_EBX
+ else
+ tmpreg:=NR_ECX;
{ Allocate registers used for parameters to make sure they
never allocated during this PIC init code }
for i:=0 to current_procinfo.procdef.paras.Count - 1 do
diff --git a/compiler/i386/cpupi.pas b/compiler/i386/cpupi.pas
index 5985ac3fb0..01eeab8978 100644
--- a/compiler/i386/cpupi.pas
+++ b/compiler/i386/cpupi.pas
@@ -100,8 +100,11 @@ unit cpupi;
begin
if (cs_create_pic in current_settings.moduleswitches) then
begin
- if pi_uses_threadvar in flags then
+ if (pi_uses_threadvar in flags) and (tf_section_threadvars in target_info.flags) then
begin
+ { FIXME: It is better to use an imaginary register for GOT and
+ if EBX is needed for some reason just allocate EBX and
+ copy GOT into it before its usage. }
cg.getcpuregister(list,NR_EBX);
got := NR_EBX;
end
diff --git a/compiler/i386/hlcgcpu.pas b/compiler/i386/hlcgcpu.pas
index 141341a475..fbd08f97ee 100644
--- a/compiler/i386/hlcgcpu.pas
+++ b/compiler/i386/hlcgcpu.pas
@@ -196,6 +196,7 @@ implementation
{ Alloc EBX }
getcpuregister(list, NR_PIC_OFFSET_REG);
list.concat(taicpu.op_reg_reg(A_MOV,S_L,current_procinfo.got,NR_PIC_OFFSET_REG));
+ include(current_procinfo.flags,pi_needs_got);
end;
Result:=inherited a_call_name(list, pd, s, paras, forceresdef, weak);
{ Free EBX }
diff --git a/compiler/nbas.pas b/compiler/nbas.pas
index 846c417369..2028ca4b35 100644
--- a/compiler/nbas.pas
+++ b/compiler/nbas.pas
@@ -1093,10 +1093,6 @@ implementation
{ temps which are immutable do not need to be initialized/finalized }
if (tempinfo^.typedef.needs_inittable) and not(ti_const in tempflags) then
include(current_procinfo.flags,pi_needs_implicit_finally);
- if (cs_create_pic in current_settings.moduleswitches) and
- (tf_pic_uses_got in target_info.flags) and
- is_rtti_managed_type(tempinfo^.typedef) then
- include(current_procinfo.flags,pi_needs_got);
if assigned(tempinfo^.withnode) then
firstpass(tempinfo^.withnode);
if assigned(tempinfo^.tempinitcode) then
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index e5f97ac18d..a0b300e020 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -1086,19 +1086,6 @@ implementation
aktcallnode.procdefinition.proccalloption) then
copy_value_by_ref_para;
- { does it need to load RTTI? }
- if assigned(parasym) and (parasym.varspez=vs_out) and
- (cs_create_pic in current_settings.moduleswitches) and
- (
- is_rtti_managed_type(left.resultdef) or
- (
- is_open_array(resultdef) and
- is_managed_type(tarraydef(resultdef).elementdef)
- )
- ) and
- not(target_info.system in systems_garbage_collected_managed_types) then
- include(current_procinfo.flags,pi_needs_got);
-
if assigned(fparainit) then
firstpass(fparainit);
firstpass(left);
@@ -4382,11 +4369,6 @@ implementation
([cnf_member_call,cnf_inherited] * callnodeflags <> []) then
current_procinfo.ConstructorCallingConstructor:=true;
- { object check helper will load VMT -> needs GOT }
- if (cs_check_object in current_settings.localswitches) and
- (cs_create_pic in current_settings.moduleswitches) then
- include(current_procinfo.flags,pi_needs_got);
-
{ Continue with checking a normal call or generate the inlined code }
if cnf_do_inline in callnodeflags then
result:=pass1_inline
diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index 017e7f5a16..e5318a4841 100644
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@@ -2022,9 +2022,6 @@ implementation
begin
s:=def.rtti_mangledname(rt)+suffix;
result:=current_asmdata.RefAsmSymbol(s,AT_DATA,indirect);
- if (cs_create_pic in current_settings.moduleswitches) and
- assigned(current_procinfo) then
- include(current_procinfo.flags,pi_needs_got);
if def.owner.moduleid<>current_module.moduleid then
current_module.add_extern_asmsym(s,AB_EXTERNAL,AT_DATA);
end;
diff --git a/compiler/ncgset.pas b/compiler/ncgset.pas
index cc7ef364a3..6397403e9c 100644
--- a/compiler/ncgset.pas
+++ b/compiler/ncgset.pas
@@ -827,7 +827,7 @@ implementation
{$endif}
{$endif cpuhighleveltarget}
begin
- hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, tcgint(t^._low),hregister, blocklabel(t^.blockid));
+ hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, tcgint(t^._low.svalue),hregister, blocklabel(t^.blockid));
end;
{ Reset last here, because we've only checked for one value and need to compare
for the next range both the lower and upper bound }
@@ -934,7 +934,7 @@ implementation
{$endif}
{$endif cpuhighleveltarget}
begin
- hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, tcgint(t^._low), hregister,
+ hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, tcgint(t^._low.svalue), hregister,
elselabel);
end;
end;
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 6cb539133a..b151d9c8a4 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -3177,9 +3177,6 @@ implementation
begin
result:=nil;
expectloc:=LOC_REGISTER;
- { Use of FPC_EMPTYCHAR label requires setting pi_needs_got flag }
- if (cs_create_pic in current_settings.moduleswitches) then
- include(current_procinfo.flags,pi_needs_got);
end;
@@ -3604,9 +3601,6 @@ implementation
begin
first_ansistring_to_pchar:=nil;
expectloc:=LOC_REGISTER;
- { Use of FPC_EMPTYCHAR label requires setting pi_needs_got flag }
- if (cs_create_pic in current_settings.moduleswitches) then
- include(current_procinfo.flags,pi_needs_got);
end;
diff --git a/compiler/ncon.pas b/compiler/ncon.pas
index 6a048420ff..392e11ea1d 100644
--- a/compiler/ncon.pas
+++ b/compiler/ncon.pas
@@ -465,8 +465,6 @@ implementation
begin
result:=nil;
expectloc:=LOC_CREFERENCE;
- if (cs_create_pic in current_settings.moduleswitches) then
- include(current_procinfo.flags,pi_needs_got);
end;
@@ -868,9 +866,6 @@ implementation
end
else
expectloc:=LOC_CREFERENCE;
- if (cs_create_pic in current_settings.moduleswitches) and
- (expectloc <> LOC_CONSTANT) then
- include(current_procinfo.flags,pi_needs_got);
end;
@@ -1160,9 +1155,6 @@ implementation
expectloc:=LOC_CONSTANT
else
expectloc:=LOC_CREFERENCE;
- if (cs_create_pic in current_settings.moduleswitches) and
- (expectloc <> LOC_CONSTANT) then
- include(current_procinfo.flags,pi_needs_got);
end;
@@ -1254,9 +1246,6 @@ implementation
begin
result:=nil;
expectloc:=LOC_CREFERENCE;
- if (cs_create_pic in current_settings.moduleswitches) and
- (tf_pic_uses_got in target_info.flags) then
- include(current_procinfo.flags,pi_needs_got);
end;
diff --git a/compiler/nflw.pas b/compiler/nflw.pas
index 5dc4a2f659..8221dac21e 100644
--- a/compiler/nflw.pas
+++ b/compiler/nflw.pas
@@ -2433,11 +2433,6 @@ implementation
begin
result:=nil;
include(current_procinfo.flags,pi_do_call);
- { Loads exception class VMT, therefore may need GOT
- (generic code only; descendants may need to avoid this check) }
- if (cs_create_pic in current_settings.moduleswitches) and
- (tf_pic_uses_got in target_info.flags) then
- include(current_procinfo.flags,pi_needs_got);
expectloc:=LOC_VOID;
if assigned(left) then
firstpass(left);
diff --git a/compiler/nld.pas b/compiler/nld.pas
index 3549617e0b..65a82a13f1 100644
--- a/compiler/nld.pas
+++ b/compiler/nld.pas
@@ -400,9 +400,6 @@ implementation
begin
result:=nil;
expectloc:=LOC_REFERENCE;
- if (cs_create_pic in current_settings.moduleswitches) and
- not(symtableentry.typ in [paravarsym,localvarsym]) then
- include(current_procinfo.flags,pi_needs_got);
case symtableentry.typ of
absolutevarsym :
@@ -424,9 +421,6 @@ implementation
else
if (tabstractvarsym(symtableentry).varspez=vs_const) then
expectloc:=LOC_CREFERENCE;
- if (target_info.system=system_powerpc_darwin) and
- ([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then
- include(current_procinfo.flags,pi_needs_got);
{ call to get address of threadvar }
if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
begin
@@ -1383,9 +1377,6 @@ implementation
begin
result:=nil;
expectloc:=LOC_CREFERENCE;
- if (cs_create_pic in current_settings.moduleswitches) and
- (tf_pic_uses_got in target_info.flags) then
- include(current_procinfo.flags,pi_needs_got);
end;
diff --git a/compiler/nmem.pas b/compiler/nmem.pas
index 8f80141c29..5d6523d271 100644
--- a/compiler/nmem.pas
+++ b/compiler/nmem.pas
@@ -242,9 +242,6 @@ implementation
begin
result:=nil;
expectloc:=LOC_REGISTER;
- if (left.nodetype=typen) and
- (cs_create_pic in current_settings.moduleswitches) then
- include(current_procinfo.flags,pi_needs_got);
if left.nodetype<>typen then
begin
if (is_objc_class_or_protocol(left.resultdef) or
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index cb7b8ed583..f5659a374a 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -1591,14 +1591,13 @@ implementation
sc : TFPObjectList;
i : longint;
hs,sorg : string;
- hdef,casetype,tmpdef : tdef;
+ hdef,casetype : tdef;
{ maxsize contains the max. size of a variant }
{ startvarrec contains the start of the variant part of a record }
maxsize, startvarrecsize : longint;
usedalign,
maxalignment,startvarrecalign,
maxpadalign, startpadalign: shortint;
- stowner : tdef;
pt : tnode;
fieldvs : tfieldvarsym;
hstaticvs : tstaticvarsym;
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index cbe7ae15ad..ae9290d6ea 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1409,9 +1409,7 @@ implementation
(current_procinfo.procdef.struct=structh))) then
Message(parser_e_only_class_members)
else
- Message(parser_e_only_class_members_via_class_ref)
- else if isobjecttype then
- Message(parser_e_only_static_members_via_object_type);
+ Message(parser_e_only_class_members_via_class_ref);
p1:=csubscriptnode.create(sym,p1);
end;
end;
diff --git a/compiler/powerpc/cpupara.pas b/compiler/powerpc/cpupara.pas
index ab774a2105..1e09f872ba 100644
--- a/compiler/powerpc/cpupara.pas
+++ b/compiler/powerpc/cpupara.pas
@@ -650,8 +650,6 @@ unit cpupara;
result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true)
else
internalerror(2019021921);
- if curfloatreg<>firstfloatreg then
- include(varargspara.varargsinfo,va_uses_float_reg);
end;
{ varargs routines have to reserve at least 32 bytes for the AIX abi }
if (target_info.abi in [abi_powerpc_aix,abi_powerpc_darwin]) and
@@ -660,6 +658,8 @@ unit cpupara;
end
else
internalerror(2019021710);
+ if curfloatreg<>firstfloatreg then
+ include(varargspara.varargsinfo,va_uses_float_reg);
create_funcretloc_info(p,side);
end;
diff --git a/compiler/powerpc64/cpupara.pas b/compiler/powerpc64/cpupara.pas
index 5f25868ca1..e545eb791b 100644
--- a/compiler/powerpc64/cpupara.pas
+++ b/compiler/powerpc64/cpupara.pas
@@ -767,8 +767,6 @@ begin
curfloatreg, curmmreg, cur_stack_offset, true)
else
internalerror(2019021920);
- if curfloatreg <> firstfloatreg then
- include(varargspara.varargsinfo, va_uses_float_reg);
end;
{ varargs routines have to reserve at least 64 bytes for the PPC64 ABI }
if (result < 64) then
@@ -776,6 +774,8 @@ begin
end
else
internalerror(2019021911);
+ if curfloatreg <> firstfloatreg then
+ include(varargspara.varargsinfo, va_uses_float_reg);
create_funcretloc_info(p, side);
end;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index c5c23d9ca1..f2fc891ca9 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -299,11 +299,6 @@ implementation
include(current_procinfo.flags,pi_needs_implicit_finally);
include(current_procinfo.flags,pi_do_call);
end;
- if (tparavarsym(p).varspez in [vs_value,vs_out]) and
- (cs_create_pic in current_settings.moduleswitches) and
- (tf_pic_uses_got in target_info.flags) and
- is_rtti_managed_type(tparavarsym(p).vardef) then
- include(current_procinfo.flags,pi_needs_got);
end;
end;
@@ -318,10 +313,6 @@ implementation
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
include(current_procinfo.flags,pi_do_call);
- if is_rtti_managed_type(tlocalvarsym(p).vardef) and
- (cs_create_pic in current_settings.moduleswitches) and
- (tf_pic_uses_got in target_info.flags) then
- include(current_procinfo.flags,pi_needs_got);
end;
end;
diff --git a/compiler/rgobj.pas b/compiler/rgobj.pas
index 7873b64f82..93f4bfbdee 100644
--- a/compiler/rgobj.pas
+++ b/compiler/rgobj.pas
@@ -1474,8 +1474,9 @@ unit rgobj;
adj : psuperregisterworklist;
maxlength,p,i :word;
minweight: longint;
- dist,
- maxdist: Double;
+ {$ifdef SPILLING_NEW}
+ dist: Double;
+ {$endif}
begin
{$ifdef SPILLING_NEW}
{ This new approach for selecting the next spill candidate takes care of the weight of a register:
diff --git a/compiler/systems/i_linux.pas b/compiler/systems/i_linux.pas
index 42f74f839d..8b0bc972e5 100644
--- a/compiler/systems/i_linux.pas
+++ b/compiler/systems/i_linux.pas
@@ -508,13 +508,13 @@ unit i_linux;
coalescealign : 0;
coalescealignskipmax: 0;
constalignmin : 4;
- constalignmax : 8;
+ constalignmax : 16;
varalignmin : 4;
- varalignmax : 8;
+ varalignmax : 16;
localalignmin : 4;
localalignmax : 8;
recordalignmin : 0;
- recordalignmax : 8;
+ recordalignmax : 16;
maxCrecordalign : 8
);
first_parm_offset : 92;
@@ -654,13 +654,13 @@ unit i_linux;
coalescealign : 0;
coalescealignskipmax: 0;
constalignmin : 0;
- constalignmax : 8;
+ constalignmax : 16;
varalignmin : 0;
- varalignmax : 8;
+ varalignmax : 16;
localalignmin : 4;
localalignmax : 8;
recordalignmin : 0;
- recordalignmax : 8;
+ recordalignmax : 16;
maxCrecordalign : 8
);
first_parm_offset : 8;
@@ -727,13 +727,13 @@ unit i_linux;
coalescealign : 0;
coalescealignskipmax: 0;
constalignmin : 0;
- constalignmax : 8;
+ constalignmax : 16;
varalignmin : 0;
- varalignmax : 8;
+ varalignmax : 16;
localalignmin : 4;
localalignmax : 8;
recordalignmin : 0;
- recordalignmax : 8;
+ recordalignmax : 16;
maxCrecordalign : 8
);
first_parm_offset : 8;
@@ -797,13 +797,13 @@ unit i_linux;
coalescealign : 0;
coalescealignskipmax: 0;
constalignmin : 0;
- constalignmax : 4;
+ constalignmax : 16;
varalignmin : 0;
- varalignmax : 4;
+ varalignmax : 16;
localalignmin : 4;
localalignmax : 8;
recordalignmin : 0;
- recordalignmax : 4;
+ recordalignmax : 16;
maxCrecordalign : 4
);
first_parm_offset : 8;
@@ -865,13 +865,13 @@ unit i_linux;
coalescealign : 0;
coalescealignskipmax: 0;
constalignmin : 0;
- constalignmax : 4;
+ constalignmax : 16;
varalignmin : 0;
- varalignmax : 4;
+ varalignmax : 16;
localalignmin : 4;
localalignmax : 4;
recordalignmin : 0;
- recordalignmax : 4;
+ recordalignmax : 16;
maxCrecordalign : 4
);
first_parm_offset : 8;
diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas
index 5364a1074e..adbbcfdcd9 100644
--- a/compiler/x86/cgx86.pas
+++ b/compiler/x86/cgx86.pas
@@ -902,10 +902,7 @@ unit cgx86;
{ darwin's assembler doesn't want @PLT after call symbols }
not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim,system_x86_64_iphonesim]) then
begin
-{$ifdef i386}
- include(current_procinfo.flags,pi_needs_got);
-{$endif i386}
- r.refaddr:=addr_pic
+ r.refaddr:=addr_pic;
end
else
r.refaddr:=addr_full;
diff --git a/compiler/x86/nx86ld.pas b/compiler/x86/nx86ld.pas
index 5e8d5dad5b..0ef54b86a5 100644
--- a/compiler/x86/nx86ld.pas
+++ b/compiler/x86/nx86ld.pas
@@ -102,6 +102,7 @@ implementation
begin
if not(cs_create_pic in current_settings.moduleswitches) then
Internalerror(2018110701);
+ include(current_procinfo.flags,pi_needs_got);
reference_reset(href,0,[]);
location.reference.index:=current_procinfo.got;
location.reference.scalefactor:=1;
diff --git a/compiler/x86/nx86set.pas b/compiler/x86/nx86set.pas
index 0e38e3e362..4de3a5ecda 100644
--- a/compiler/x86/nx86set.pas
+++ b/compiler/x86/nx86set.pas
@@ -176,6 +176,7 @@ implementation
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,jumpreg);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,current_procinfo.got,jumpreg);
emit_reg(A_JMP,S_NO,jumpreg);
+ include(current_procinfo.flags,pi_needs_got);
end
else
emit_ref(A_JMP,S_NO,href);
diff --git a/packages/fcl-js/tests/testjs.lpr b/packages/fcl-js/tests/testjs.lpr
index 9f8da1a151..4e0e30812e 100644
--- a/packages/fcl-js/tests/testjs.lpr
+++ b/packages/fcl-js/tests/testjs.lpr
@@ -12,10 +12,6 @@ uses
var
Application: TTestRunner;
-{$IFDEF WINDOWS}{$R testjs.rc}{$ENDIF}
-
-{$R *.res}
-
begin
DefaultFormat:=fplain;
DefaultRunAllTests:=True;
diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp
index 75d889ba35..e4647f9733 100644
--- a/packages/fcl-json/src/fpjson.pp
+++ b/packages/fcl-json/src/fpjson.pp
@@ -2496,7 +2496,7 @@ begin
vtChar : Result:=CreateJSON(VChar);
vtExtended : Result:=CreateJSON(VExtended^);
vtString : Result:=CreateJSON(vString^);
- vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
+ vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
vtPChar : Result:=CreateJSON(StrPas(VPChar));
vtPointer : If (VPointer<>Nil) then
TJSONData.DoError(SErrPointerNotNil,[SourceType])
@@ -3153,7 +3153,7 @@ constructor TJSONObject.Create(const Elements: array of {$ifdef pas2js}jsvalue{$
Var
I : integer;
- AName : String;
+ AName : TJSONUnicodeStringType;
J : TJSONData;
begin
@@ -3171,10 +3171,10 @@ begin
{$else}
With Elements[i] do
Case VType of
- vtChar : AName:=VChar;
- vtString : AName:=vString^;
- vtAnsiString : AName:=(AnsiString(vAnsiString));
- vtPChar : AName:=StrPas(VPChar);
+ vtChar : AName:=TJSONUnicodeStringType(VChar);
+ vtString : AName:=TJSONUnicodeStringType(vString^);
+ vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
+ vtPChar : AName:=TJSONUnicodeStringType(StrPas(VPChar));
else
DoError(SErrNameMustBeString,[I+1]);
end;
@@ -3183,7 +3183,11 @@ begin
DoError(SErrNameMustBeString,[I+1]);
Inc(I);
J:=VarRecToJSON(Elements[i],'Object');
+ {$IFDEF FPC_HAS_CPSTRING}
+ Add(UTF8Encode(AName),J);
+ {$ELSE}
Add(AName,J);
+ {$ENDIF}
Inc(I);
end;
end;
diff --git a/packages/fcl-json/src/jsonconf.pp b/packages/fcl-json/src/jsonconf.pp
index 0598b548cd..794c796e99 100644
--- a/packages/fcl-json/src/jsonconf.pp
+++ b/packages/fcl-json/src/jsonconf.pp
@@ -90,13 +90,21 @@ type
Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
function GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
+ function GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString; overload;
function GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
+ function GetValue(const APath: RawByteString; ADefault: Integer): Integer; overload;
function GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
+ function GetValue(const APath: RawByteString; ADefault: Int64): Int64; overload;
function GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
+ function GetValue(const APath: RawByteString; ADefault: Boolean): Boolean; overload;
function GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
+ function GetValue(const APath: RawByteString; ADefault: Double): Double; overload;
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
+ Function GetValue(const APath: RawByteString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
+
procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
+ procedure SetValue(const APath: RawByteString; const AValue: RawByteString); overload;
procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
@@ -289,6 +297,12 @@ begin
end;
+function TJSONConfig.GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString;
+
+begin
+ Result:=GetValue(UTF8Decode(aPath),UTF8Decode(ADefault));
+end;
+
function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
var
@@ -302,6 +316,12 @@ begin
Result:=ADefault;
end;
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Integer): Integer;
+
+begin
+ Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
var
El : TJSONData;
@@ -316,6 +336,12 @@ begin
Result:=StrToIntDef(El.AsString,ADefault);
end;
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Int64): Int64;
+
+begin
+ Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
var
El : TJSONData;
@@ -330,6 +356,12 @@ begin
Result:=StrToInt64Def(El.AsString,ADefault);
end;
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Boolean): Boolean;
+
+begin
+ Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
var
@@ -345,6 +377,12 @@ begin
Result:=StrToBoolDef(El.AsString,ADefault);
end;
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Double): Double;
+
+begin
+ Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
var
@@ -360,6 +398,14 @@ begin
Result:=StrToFloatDef(El.AsString,ADefault);
end;
+function TJSONConfig.GetValue(const APath: RawByteString; AValue: TStrings;
+ const ADefault: String): Boolean;
+
+begin
+ Result:=GetValue(UTF8Decode(aPath),AValue, ADefault);
+end;
+
+
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
const ADefault: String): Boolean;
var
@@ -418,6 +464,13 @@ begin
FModified:=True;
end;
+
+procedure TJSONConfig.SetValue(const APath: RawByteString;
+ const AValue: RawByteString);
+begin
+ SetValue(UTF8Decode(APath),UTF8Decode(AValue));
+end;
+
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
begin
if AValue = DefValue then
diff --git a/packages/fcl-json/src/jsonreader.pp b/packages/fcl-json/src/jsonreader.pp
index 5147538a11..ce4fbee468 100644
--- a/packages/fcl-json/src/jsonreader.pp
+++ b/packages/fcl-json/src/jsonreader.pp
@@ -36,7 +36,7 @@ Type
procedure DoError(const Msg: String);
Procedure DoParse(AtCurrent,AllowEOF: Boolean);
function GetNextToken: TJSONToken;
- function CurrentTokenString: String;
+ function CurrentTokenString: RawByteString;
function CurrentToken: TJSONToken; inline;
Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
@@ -203,7 +203,7 @@ begin
Result:=FScanner.CurToken;
end;
-function TBaseJSONReader.CurrentTokenString: String;
+function TBaseJSONReader.CurrentTokenString: RawByteString;
begin
If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp
index eedf88a664..aa0701b53d 100644
--- a/packages/fcl-json/src/jsonscanner.pp
+++ b/packages/fcl-json/src/jsonscanner.pp
@@ -28,7 +28,7 @@ uses SysUtils, Classes;
resourcestring
SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
- SErrOpenString = 'string exceeds end of line';
+ SErrOpenString = 'string exceeds end of line %d';
type
@@ -331,7 +331,7 @@ begin
u1:=u2;
end
end;
- #0 : Error(SErrOpenString);
+ #0 : Error(SErrOpenString,[FCurRow]);
else
Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
end;
@@ -355,11 +355,11 @@ begin
else
MaybeAppendUnicode;
if FTokenStr[0] = #0 then
- Error(SErrOpenString);
+ Error(SErrOpenString,[FCurRow]);
Inc(FTokenStr);
end;
if FTokenStr[0] = #0 then
- Error(SErrOpenString);
+ Error(SErrOpenString,[FCurRow]);
MaybeAppendUnicode;
SectionLength := FTokenStr - TokenStart;
SetLength(FCurTokenString, OldLength + SectionLength);
diff --git a/packages/fcl-json/tests/jsonconftest.pp b/packages/fcl-json/tests/jsonconftest.pp
index c93dc7d94b..2ff62b18df 100644
--- a/packages/fcl-json/tests/jsonconftest.pp
+++ b/packages/fcl-json/tests/jsonconftest.pp
@@ -27,6 +27,7 @@ type
procedure TestKey;
procedure TestStrings;
procedure TestUnicodeStrings;
+ procedure TestUnicodeStrings2;
end;
implementation
@@ -352,6 +353,34 @@ begin
end;
end;
+procedure TTestJSONConfig.TestUnicodeStrings2;
+
+Const
+ utf8str = 'Größe ÄÜÖ ㎰ す 가';
+ utf8path = 'Größe/す가';
+
+Var
+ Co : TJSONCOnfig;
+
+
+begin
+ Co:=CreateConf('test.json');
+ try
+ Co.SetValue('/проверка',utf8str);
+ Co.SetValue(utf8path,'something');
+ Co.Flush;
+ finally
+ co.Free;
+ end;
+ Co:=CreateConf('test.json');
+ try
+ AssertEquals('UTF8 string read/Write',utf8str,utf8encode(Co.GetValue('/проверка','')));
+ AssertEquals('UTF8 path read/Write','something',Co.GetValue(utf8path,'something'));
+ finally
+ DeleteConf(Co,True);
+ end;
+end;
+
initialization
diff --git a/packages/fcl-json/tests/testjsonconf.lpi b/packages/fcl-json/tests/testjsonconf.lpi
index 212066ba87..3f92df3d37 100644
--- a/packages/fcl-json/tests/testjsonconf.lpi
+++ b/packages/fcl-json/tests/testjsonconf.lpi
@@ -14,9 +14,6 @@
</BuildModes>
<PublishOptions>
<Version Value="2"/>
- <IgnoreBinaries Value="False"/>
- <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
- <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
diff --git a/packages/fcl-passrc/src/pasresolveeval.pas b/packages/fcl-passrc/src/pasresolveeval.pas
index e0379ecd3f..a99e217233 100644
--- a/packages/fcl-passrc/src/pasresolveeval.pas
+++ b/packages/fcl-passrc/src/pasresolveeval.pas
@@ -181,7 +181,7 @@ const
nDerivedXMustExtendASubClassY = 3115;
nDefaultPropertyNotAllowedInHelperForX = 3116;
nHelpersCannotBeUsedAsTypes = 3117;
- nBitWiseOperationsAre32Bit = 3118;
+ // free 3118
nImplictConversionUnicodeToAnsi = 3119;
nWrongTypeXInArrayConstructor = 3120;
nUnknownCustomAttributeX = 3121;
@@ -315,7 +315,7 @@ resourcestring
sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
- sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
+ // was 3118
sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';
diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp
index 4d8ec61664..6fd12a1d40 100644
--- a/packages/fcl-passrc/src/pasresolver.pp
+++ b/packages/fcl-passrc/src/pasresolver.pp
@@ -9205,7 +9205,8 @@ begin
end
else if LTypeEl.ClassType=TPasEnumType then
begin
- if LeftResolved.IdentEl is TPasEnumType then
+ if (LeftResolved.IdentEl is TPasType)
+ and (ResolveAliasType(TPasType(LeftResolved.IdentEl)).ClassType=TPasEnumType) then
begin
// e.g. TShiftState.ssAlt
DotScope:=PushEnumDotScope(TPasEnumType(LTypeEl));
@@ -16283,23 +16284,25 @@ begin
if (TypeEl.ClassType=TPasClassType)
and (TPasClassType(TypeEl).HelperForType<>nil) then
TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
- if (TypeEl.ClassType=TPasClassType) and
- TPasClassType(TypeEl).IsAbstract then
- LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
- sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl);
TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
begin
- AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
- if (length(AbstractProcs)>0) then
+ if (TypeEl.ClassType=TPasClassType) and TPasClassType(TypeEl).IsAbstract then
+ LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
+ sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl)
+ else
begin
- if IsClassOf then
- // aClass.Create: do not warn
- else
- for i:=0 to length(AbstractProcs)-1 do
- LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
- sConstructingClassXWithAbstractMethodY,
- [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+ AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
+ if (length(AbstractProcs)>0) then
+ begin
+ if IsClassOf then
+ // aClass.Create: do not warn
+ else
+ for i:=0 to length(AbstractProcs)-1 do
+ LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
+ sConstructingClassXWithAbstractMethodY,
+ [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+ end;
end;
end;
end;
@@ -17094,7 +17097,7 @@ begin
Scope.Add(HelperScope);
HelperScope:=HelperScope.AncestorScope;
end;
- if not (msMultipleScopeHelpers in CurrentParser.CurrentModeswitches) then
+ if not (msMultiHelpers in CurrentParser.CurrentModeswitches) then
break;
end;
end;
diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas
index 3eddc33efe..7bd969cdcd 100644
--- a/packages/fcl-passrc/src/pasuseanalyzer.pas
+++ b/packages/fcl-passrc/src/pasuseanalyzer.pas
@@ -1475,6 +1475,7 @@ var
ModScope: TPasModuleScope;
Access: TResolvedRefAccess;
SubEl: TPasElement;
+ ParamsExpr: TParamsExpr;
begin
if El=nil then exit;
// Note: expression itself is not marked, but it can reference identifiers
@@ -1527,7 +1528,8 @@ begin
case BuiltInProc.BuiltIn of
bfExit:
begin
- if El.Parent is TParamsExpr then
+ ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
+ if ParamsExpr<>nil then
begin
Params:=(El.Parent as TParamsExpr).Params;
if length(Params)=1 then
@@ -1546,7 +1548,10 @@ begin
end;
bfTypeInfo:
begin
- Params:=(El.Parent as TParamsExpr).Params;
+ ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
+ if ParamsExpr=nil then
+ RaiseNotSupported(20190225150136,El);
+ Params:=ParamsExpr.Params;
if length(Params)<>1 then
RaiseNotSupported(20180226144217,El.Parent);
Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
@@ -1773,6 +1778,9 @@ begin
{$IFDEF VerbosePasAnalyzer}
writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
{$ENDIF}
+ if Proc.Parent is TPasMembersType then
+ UseClassOrRecType(TPasMembersType(Proc.Parent),paumElement);
+
UseScopeReferences(ProcScope.References);
UseProcedureType(Proc.ProcType);
@@ -2006,7 +2014,7 @@ begin
RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
end;
{$IFDEF VerbosePasAnalyzer}
- writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
+ writeln('TPasAnalyzer.UseClassOrRecType ',GetElModName(El),' ',Mode,' First=',FirstTime);
{$ENDIF}
aClass:=nil;
ClassScope:=nil;
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 828b3c0b5c..fd9d759006 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -3909,7 +3909,7 @@ begin
NextToken;
if not (CurToken in [tkChar,tkString,tkIdentifier]) then
ParseExcTokenError(TokenInfos[tkString]);
- Result.ExportName:=DoParseExpression(Parent);
+ Result.ExportName:=DoParseExpression(Result);
Result.IsConst:=true; // external const is readonly
end
else if CurToken=tkSemicolon then
@@ -4326,7 +4326,7 @@ begin
UngetToken;
exit;
end;
- Include(varMods,ExtMod);
+ Include(VarMods,ExtMod);
Result:=Result+';'+CurTokenText;
NextToken;
@@ -4444,14 +4444,14 @@ begin
NextToken;
If Curtoken<>tkSemicolon then
UnGetToken;
- VarEl:=TPasVariable(VarList[0]);
+ VarEl:=TPasVariable(VarList[OldListCount]);
AllowedVarMods:=[];
if ExternalStruct then
AllowedVarMods:=[vmExternal]
else
AllowedVarMods:=[vmCVar,vmExternal,vmPublic,vmExport];
Mods:=GetVariableModifiers(VarEl,VarMods,aLibName,aExpName,AllowedVarMods);
- if (mods='') and (CurToken<>tkSemicolon) then
+ if (Mods='') and (CurToken<>tkSemicolon) then
NextToken;
end
else
diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp
index 14d4bcd5c5..5953604daf 100644
--- a/packages/fcl-passrc/src/pscanner.pp
+++ b/packages/fcl-passrc/src/pscanner.pp
@@ -294,7 +294,7 @@ type
msExternalClass, { Allow external class definitions }
msPrefixedAttributes, { Allow attributes, disable proc modifier [] }
msOmitRTTI, { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
- msMultipleScopeHelpers { off=only one helper per type, on=all }
+ msMultiHelpers { off=only one helper per type, on=all }
);
TModeSwitches = Set of TModeSwitch;
@@ -1038,7 +1038,7 @@ const
'EXTERNALCLASS',
'PREFIXEDATTRIBUTES',
'OMITRTTI',
- 'MULTIPLESCOPEHELPERS'
+ 'MULTIHELPERS'
);
LetterSwitchNames: array['A'..'Z'] of string=(
@@ -3271,10 +3271,8 @@ begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[Identifier]);
exit;
end;
- end;
-
- if Number>=0 then
SetWarnMsgState(Number,State);
+ end;
end;
procedure TPascalScanner.HandleDefine(Param: String);
diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas
index e08c013a20..ca5bcf88ae 100644
--- a/packages/fcl-passrc/tests/tcresolver.pas
+++ b/packages/fcl-passrc/tests/tcresolver.pas
@@ -609,6 +609,7 @@ type
Procedure TestClass_UntypedParam_TypeCast;
Procedure TestClass_Sealed;
Procedure TestClass_SealedDescendFail;
+ Procedure TestClass_Abstract;
Procedure TestClass_AbstractCreateFail;
Procedure TestClass_VarExternal;
Procedure TestClass_WarnOverrideLowerVisibility;
@@ -913,7 +914,7 @@ type
Procedure TestClassHelper_ReintroduceHides_CallFail;
Procedure TestClassHelper_DefaultProperty;
Procedure TestClassHelper_DefaultClassProperty;
- Procedure TestClassHelper_MultipleScopeHelpers;
+ Procedure TestClassHelper_MultiHelpers;
Procedure TestRecordHelper;
Procedure TestRecordHelper_ForByteFail;
Procedure TestRecordHelper_ClassNonStaticFail;
@@ -929,6 +930,7 @@ type
Procedure TestTypeHelper_Enumerator;
Procedure TestTypeHelper_String;
Procedure TestTypeHelper_Boolean;
+ Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_Constructor_NewInstance;
Procedure TestTypeHelper_InterfaceFail;
@@ -3681,25 +3683,30 @@ end;
procedure TTestResolver.TestEnums;
begin
StartProgram(false);
- Add('type {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);');
- Add('var');
- Add(' {#f}{=TFlag}f: TFlag;');
- Add(' {#v}{=TFlag}v: TFlag = Green;');
- Add(' {#i}i: longint;');
- Add('begin');
- Add(' {@f}f:={@Red}Red;');
- Add(' {@f}f:={@v}v;');
- Add(' if {@f}f={@Red}Red then ;');
- Add(' if {@f}f={@v}v then ;');
- Add(' if {@f}f>{@v}v then ;');
- Add(' if {@f}f<{@v}v then ;');
- Add(' if {@f}f>={@v}v then ;');
- Add(' if {@f}f<={@v}v then ;');
- Add(' if {@f}f<>{@v}v then ;');
- Add(' if ord({@f}f)<>ord({@Red}Red) then ;');
- Add(' {@f}f:={@TFlag}TFlag.{@Red}Red;');
- Add(' {@f}f:={@TFlag}TFlag({@i}i);');
- Add(' {@i}i:=longint({@f}f);');
+ Add([
+ 'type',
+ ' {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);',
+ ' {#TAlias}TAlias = TFlag;',
+ 'var',
+ ' {#f}{=TFlag}f: TFlag;',
+ ' {#v}{=TFlag}v: TFlag = Green;',
+ ' {#i}i: longint;',
+ 'begin',
+ ' {@f}f:={@Red}Red;',
+ ' {@f}f:={@v}v;',
+ ' if {@f}f={@Red}Red then ;',
+ ' if {@f}f={@v}v then ;',
+ ' if {@f}f>{@v}v then ;',
+ ' if {@f}f<{@v}v then ;',
+ ' if {@f}f>={@v}v then ;',
+ ' if {@f}f<={@v}v then ;',
+ ' if {@f}f<>{@v}v then ;',
+ ' if ord({@f}f)<>ord({@Red}Red) then ;',
+ ' {@f}f:={@TFlag}TFlag.{@Red}Red;',
+ ' {@f}f:={@TFlag}TFlag({@i}i);',
+ ' {@i}i:=longint({@f}f);',
+ ' {@f}f:={@TAlias}TAlias.{@Green}Green;',
+ '']);
ParseProgram;
end;
@@ -9703,40 +9710,42 @@ end;
procedure TTestResolver.TestClassCallInherited;
begin
StartProgram(false);
- Add('type');
- Add(' TObject = class');
- Add(' procedure {#TOBJ_ProcA}ProcA(vI: longint); virtual;');
- Add(' procedure {#TOBJ_ProcB}ProcB(vJ: longint); virtual;');
- Add(' end;');
- Add(' {#A}TClassA = class');
- Add(' procedure {#A_ProcA}ProcA({#i1}vI: longint); override;');
- Add(' procedure {#A_ProcB}ProcB(vJ: longint); override;');
- Add(' procedure {#A_ProcC}ProcC; virtual;');
- Add(' end;');
- Add('procedure TObject.ProcA(vi: longint);');
- Add('begin');
- Add(' inherited; // ignore, do not raise error');
- Add('end;');
- Add('procedure TObject.ProcB(vj: longint);');
- Add('begin');
- Add('end;');
- Add('procedure TClassA.ProcA(vi: longint);');
- Add('begin');
- Add(' {@A_ProcA}ProcA({@i1}vI);');
- Add(' {@TOBJ_ProcA}inherited;');
- Add(' inherited {@TOBJ_ProcA}ProcA({@i1}vI);');
- Add(' {@A_ProcB}ProcB({@i1}vI);');
- Add(' inherited {@TOBJ_ProcB}ProcB({@i1}vI);');
- Add('end;');
- Add('procedure TClassA.ProcB(vJ: longint);');
- Add('begin');
- Add('end;');
- Add('procedure TClassA.ProcC;');
- Add('begin');
- Add(' inherited; // ignore, do not raise error');
- Add('end;');
- Add('begin');
+ Add([
+ 'type',
+ ' TObject = class',
+ ' procedure {#TOBJ_ProcA}ProcA(vI: longint); virtual;',
+ ' procedure {#TOBJ_ProcB}ProcB(vJ: longint); virtual;',
+ ' end;',
+ ' {#A}TClassA = class',
+ ' procedure {#A_ProcA}ProcA({#i1}vI: longint); override;',
+ ' procedure {#A_ProcB}ProcB(vJ: longint); override;',
+ ' procedure {#A_ProcC}ProcC; virtual;',
+ ' end;',
+ 'procedure TObject.ProcA(vi: longint);',
+ 'begin',
+ ' inherited; // ignore, do not raise error',
+ 'end;',
+ 'procedure TObject.ProcB(vj: longint);',
+ 'begin',
+ 'end;',
+ 'procedure TClassA.ProcA(vi: longint);',
+ 'begin',
+ ' {@A_ProcA}ProcA({@i1}vI);',
+ ' {@TOBJ_ProcA}inherited;',
+ ' inherited {@TOBJ_ProcA}ProcA({@i1}vI);',
+ ' {@A_ProcB}ProcB({@i1}vI);',
+ ' inherited {@TOBJ_ProcB}ProcB({@i1}vI);',
+ 'end;',
+ 'procedure TClassA.ProcB(vJ: longint);',
+ 'begin',
+ 'end;',
+ 'procedure TClassA.ProcC;',
+ 'begin',
+ ' inherited; // ignore, do not raise error',
+ 'end;',
+ 'begin']);
ParseProgram;
+ CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestClassCallInheritedNoParamsAbstractFail;
@@ -10836,6 +10845,32 @@ begin
nCannotCreateADescendantOfTheSealedXY);
end;
+procedure TTestResolver.TestClass_Abstract;
+begin
+ StartProgram(false);
+ Add([
+ 'type',
+ ' TObject = class',
+ ' constructor Create;',
+ ' end;',
+ ' TNop = class abstract(TObject)',
+ ' end;',
+ ' TBird = class(TNop)',
+ ' constructor Create(w: word);',
+ ' end;',
+ 'constructor TObject.Create;',
+ 'begin',
+ 'end;',
+ 'constructor TBird.Create(w: word);',
+ 'begin',
+ ' inherited Create;',
+ 'end;',
+ 'begin',
+ ' TBird.Create;']);
+ ParseProgram;
+ CheckResolverUnexpectedHints;
+end;
+
procedure TTestResolver.TestClass_AbstractCreateFail;
begin
StartProgram(false);
@@ -16963,11 +16998,11 @@ begin
ParseProgram;
end;
-procedure TTestResolver.TestClassHelper_MultipleScopeHelpers;
+procedure TTestResolver.TestClassHelper_MultiHelpers;
begin
StartProgram(false);
Add([
- '{$modeswitch multiplescopehelpers}',
+ '{$modeswitch multihelpers}',
'type',
' TObject = class',
' end;',
@@ -17454,6 +17489,30 @@ begin
ParseProgram;
end;
+procedure TTestResolver.TestTypeHelper_Double;
+begin
+ StartProgram(false);
+ Add([
+ '{$modeswitch typehelpers}',
+ 'type',
+ ' Float = type double;',
+ ' THelper = type helper for float',
+ ' const NPI = 3.141592;',
+ ' function ToStr: String;',
+ ' end;',
+ 'function THelper.ToStr: String;',
+ 'begin',
+ 'end;',
+ 'var',
+ ' a,b: Float;',
+ ' s: string;',
+ 'begin',
+ ' s:=(a * b.NPI).ToStr;',
+ ' s:=(a * float.NPI).ToStr;',
+ '']);
+ ParseProgram;
+end;
+
procedure TTestResolver.TestTypeHelper_Constructor_NewInstance;
var
aMarker: PSrcMarker;
diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas
index 83cc65c23c..91831fbc3d 100644
--- a/packages/fcl-passrc/tests/tcuseanalyzer.pas
+++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas
@@ -168,6 +168,7 @@ type
procedure TestWP_ClassHelper_ClassConstrucor_Used;
procedure TestWP_Attributes;
procedure TestWP_Attributes_ForwardClass;
+ procedure TestWP_Attributes_Params;
// scope references
procedure TestSR_Proc_UnitVar;
@@ -2265,6 +2266,13 @@ end;
procedure TTestUseAnalyzer.TestWP_UnitInitialization;
begin
+ AddModuleWithIntfImplSrc('unit2.pp',
+ LinesToStr([
+ 'var i: longint;',
+ '']),
+ LinesToStr([
+ '']));
+
AddModuleWithIntfImplSrc('unit1.pp',
LinesToStr([
'uses unit2;',
@@ -2273,13 +2281,6 @@ begin
'initialization',
'i:=2;']));
- AddModuleWithIntfImplSrc('unit2.pp',
- LinesToStr([
- 'var i: longint;',
- '']),
- LinesToStr([
- '']));
-
StartProgram(true);
Add('uses unit1;');
Add('begin');
@@ -3204,6 +3205,37 @@ begin
AnalyzeWholeProgram;
end;
+procedure TTestUseAnalyzer.TestWP_Attributes_Params;
+begin
+ StartProgram(false);
+ Add([
+ '{$modeswitch prefixedattributes}',
+ 'type',
+ ' TObject = class',
+ ' constructor {#TObject_Create_notused}Create;',
+ ' destructor {#TObject_Destroy_used}Destroy; virtual;',
+ ' end;',
+ ' {#TCustomAttribute_used}TCustomAttribute = class',
+ ' end;',
+ ' {#BigAttribute_used}BigAttribute = class(TCustomAttribute)',
+ ' constructor {#Big_A_used}Create(Id: word = 3); overload;',
+ ' destructor {#Big_B_used}Destroy; override;',
+ ' end;',
+ 'constructor TObject.Create; begin end;',
+ 'destructor TObject.Destroy; begin end;',
+ 'constructor BigAttribute.Create(Id: word); begin end;',
+ 'destructor BigAttribute.Destroy; begin end;',
+ 'var',
+ ' [Big(3)]',
+ ' o: TObject;',
+ ' a: TCustomAttribute;',
+ 'begin',
+ ' if typeinfo(o)=nil then ;',
+ ' a.Destroy;',
+ '']);
+ AnalyzeWholeProgram;
+end;
+
procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
begin
StartUnit(false);
diff --git a/packages/fcl-web/fpmake.pp b/packages/fcl-web/fpmake.pp
index de9c82ff2a..75840d2a0a 100644
--- a/packages/fcl-web/fpmake.pp
+++ b/packages/fcl-web/fpmake.pp
@@ -373,6 +373,12 @@ begin
AddUnit('sqldbrestschema');
AddUnit('sqldbrestconst');
end;
+ T:=P.Targets.AddUnit('sqldbrestmodule.pp');
+ With T.Dependencies do
+ begin
+ AddUnit('sqldbrestbridge');
+ AddUnit('sqldbrestconst');
+ end;
{$ifndef ALLPACKAGES}
Run;
diff --git a/packages/fcl-web/src/restbridge/sqldbrestconst.pp b/packages/fcl-web/src/restbridge/sqldbrestconst.pp
index 101ecd6079..53046dcf38 100644
--- a/packages/fcl-web/src/restbridge/sqldbrestconst.pp
+++ b/packages/fcl-web/src/restbridge/sqldbrestconst.pp
@@ -44,6 +44,7 @@ Resourcestring
SErrMissingDocumentRoot = 'Missing document root';
SErrInvalidCDSMissingElement = 'Invalid CDS Data packet: missing %s element';
SErrNoResourceDataFound = 'Failed to find resource data in input';
+ SErrNoRESTDispatcher = 'No REST bridge dispatcher assigned to handle request!';
Const
DefaultAuthenticationRealm = 'REST API Server';
diff --git a/packages/fcl-web/src/restbridge/sqldbrestio.pp b/packages/fcl-web/src/restbridge/sqldbrestio.pp
index de1b19c7ce..4ddb320c84 100644
--- a/packages/fcl-web/src/restbridge/sqldbrestio.pp
+++ b/packages/fcl-web/src/restbridge/sqldbrestio.pp
@@ -85,6 +85,7 @@ Type
private
FValues : Array[TRestStringProperty] of UTF8String;
function GetRestPropName(AIndex: Integer): UTF8String;
+ function IsRestStringStored(AIndex: Integer): Boolean;
procedure SetRestPropName(AIndex: Integer; AValue: UTF8String);
Public
Class Function GetDefaultString(aString : TRestStringProperty) :UTF8String;
@@ -93,43 +94,43 @@ Type
Procedure Assign(aSource : TPersistent); override;
Published
// Indexes here MUST match TRestProperty
- Property RESTDateFormat : UTF8String Index ord(rpDateFormat) Read GetRestPropName Write SetRestPropName;
- Property RESTDateTimeFormat : UTF8String Index ord(rpDateTimeFormat) Read GetRestPropName Write SetRestPropName;
- Property RESTTimeFormat : UTF8String Index ord(rpTimeFormat) Read GetRestPropName Write SetRestPropName;
- Property DataProperty : UTF8String Index ord(rpDataRoot) Read GetRestPropName Write SetRestPropName;
- Property MetaDataRoot : UTF8String Index ord(rpMetaDataRoot) Read GetRestPropName Write SetRestPropName;
- Property ErrorProperty : UTF8String Index ord(rpErrorRoot) Read GetRestPropName Write SetRestPropName;
- Property FieldNameProperty : UTF8String Index ord(rpFieldNameProp) Read GetRestPropName Write SetRestPropName;
- Property FieldTypeProperty : UTF8String Index ord(rpFieldTypeProp) Read GetRestPropName Write SetRestPropName;
- Property DateFormatProperty : UTF8String Index ord(rpFieldDateFormatProp) Read GetRestPropName Write SetRestPropName;
- Property MaxLenProperty : UTF8String Index ord(rpFieldMaxLenProp) Read GetRestPropName Write SetRestPropName;
- Property HumanReadableParam : UTF8String Index ord(rpHumanReadable) Read GetRestPropName Write SetRestPropName;
- Property FieldListParam : UTF8String Index ord(rpFieldList) Read GetRestPropName Write SetRestPropName;
- Property ExcludeFieldListParam : UTF8String Index ord(rpExcludeFieldList) Read GetRestPropName Write SetRestPropName;
- Property ConnectionParam : UTF8String Index Ord(rpConnection) Read GetRestPropName Write SetRestPropName;
- Property ResourceParam : UTF8String Index ord(rpResource) Read GetRestPropName Write SetRestPropName;
- Property IncludeMetadataParam : UTF8String Index ord(rpIncludeMetadata) Read GetRestPropName Write SetRestPropName;
- Property SparseParam : UTF8String Index Ord(rpSparse) Read GetRestPropName Write SetRestPropName;
- Property RowName : UTF8String Index Ord(rpRowName) Read GetRestPropName Write SetRestPropName;
- Property MetadataFields : UTF8String Index Ord(rpMetadataFields) Read GetRestPropName Write SetRestPropName;
- Property MetadataField : UTF8String Index Ord(rpMetadataField) Read GetRestPropName Write SetRestPropName;
- Property ErrorCode : UTF8String Index ord(rpErrorCode) Read GetRestPropName Write SetRestPropName;
- Property ErrorMessage : UTF8String Index ord(rpErrorMessage) Read GetRestPropName Write SetRestPropName;
- Property FilterParamEqual : UTF8String Index ord(rpFilterEqual) Read GetRestPropName Write SetRestPropName;
- Property FilterParamLessThan : UTF8String Index ord(rpFilterLessThan) Read GetRestPropName Write SetRestPropName;
- Property FilterParamGreaterThan : UTF8String Index ord(rpFilterGreaterThan) Read GetRestPropName Write SetRestPropName;
- Property FilterParamLessThanEqual : UTF8String Index ord(rpFilterLessThanEqual) Read GetRestPropName Write SetRestPropName;
- Property FilterParamGreaterThanEqual : UTF8String Index ord(rpFilterGreaterThanEqual) Read GetRestPropName Write SetRestPropName;
- Property FilterParamIsNull : UTF8String Index ord(rpFilterIsNull) Read GetRestPropName Write SetRestPropName;
- Property LimitParam : UTF8string Index ord(rpLimit) Read GetRestPropName Write SetRestPropName;
- Property OffsetParam : UTF8string Index ord(rpOffset) Read GetRestPropName Write SetRestPropName;
- Property SortParam : UTF8string Index ord(rpOrderBy) Read GetRestPropName Write SetRestPropName;
- Property MetadataResourceName : UTF8string Index ord(rpMetadataResourceName) Read GetRestPropName Write SetRestPropName;
- Property InputFormatParam : UTF8string Index ord(rpInputFormat) Read GetRestPropName Write SetRestPropName;
- Property OutputFormatParam : UTF8string Index ord(rpOutputFormat) Read GetRestPropName Write SetRestPropName;
- Property CustomViewResourceName : UTF8string Index ord(rpCustomViewResourceName) Read GetRestPropName Write SetRestPropName;
- Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName;
- Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName;
+ Property RESTDateFormat : UTF8String Index ord(rpDateFormat) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property RESTDateTimeFormat : UTF8String Index ord(rpDateTimeFormat) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property RESTTimeFormat : UTF8String Index ord(rpTimeFormat) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property DataProperty : UTF8String Index ord(rpDataRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property MetaDataRoot : UTF8String Index ord(rpMetaDataRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property ErrorProperty : UTF8String Index ord(rpErrorRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FieldNameProperty : UTF8String Index ord(rpFieldNameProp) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FieldTypeProperty : UTF8String Index ord(rpFieldTypeProp) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property DateFormatProperty : UTF8String Index ord(rpFieldDateFormatProp) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property MaxLenProperty : UTF8String Index ord(rpFieldMaxLenProp) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property HumanReadableParam : UTF8String Index ord(rpHumanReadable) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FieldListParam : UTF8String Index ord(rpFieldList) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property ExcludeFieldListParam : UTF8String Index ord(rpExcludeFieldList) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property ConnectionParam : UTF8String Index Ord(rpConnection) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property ResourceParam : UTF8String Index ord(rpResource) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property IncludeMetadataParam : UTF8String Index ord(rpIncludeMetadata) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property SparseParam : UTF8String Index Ord(rpSparse) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property RowName : UTF8String Index Ord(rpRowName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property MetadataFields : UTF8String Index Ord(rpMetadataFields) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property MetadataField : UTF8String Index Ord(rpMetadataField) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property ErrorCode : UTF8String Index ord(rpErrorCode) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property ErrorMessage : UTF8String Index ord(rpErrorMessage) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FilterParamEqual : UTF8String Index ord(rpFilterEqual) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FilterParamLessThan : UTF8String Index ord(rpFilterLessThan) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FilterParamGreaterThan : UTF8String Index ord(rpFilterGreaterThan) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FilterParamLessThanEqual : UTF8String Index ord(rpFilterLessThanEqual) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FilterParamGreaterThanEqual : UTF8String Index ord(rpFilterGreaterThanEqual) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property FilterParamIsNull : UTF8String Index ord(rpFilterIsNull) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property LimitParam : UTF8string Index ord(rpLimit) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property OffsetParam : UTF8string Index ord(rpOffset) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property SortParam : UTF8string Index ord(rpOrderBy) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property MetadataResourceName : UTF8string Index ord(rpMetadataResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property InputFormatParam : UTF8string Index ord(rpInputFormat) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property OutputFormatParam : UTF8string Index ord(rpOutputFormat) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property CustomViewResourceName : UTF8string Index ord(rpCustomViewResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+ Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
end;
{ TRestStreamer }
@@ -491,6 +492,16 @@ begin
Result:=DefaultPropertyNames[TRestStringProperty(AIndex)]
end;
+function TRestStringsConfig.IsRestStringStored(AIndex: Integer): Boolean;
+
+Var
+ V : UTF8String;
+
+begin
+ V:=FValues[TRestStringProperty(AIndex)];
+ Result:=(V<>'') and (V<>DefaultPropertyNames[TRestStringProperty(AIndex)]);
+end;
+
procedure TRestStringsConfig.SetRestPropName(AIndex: Integer; AValue: UTF8String);
begin
FValues[TRestStringProperty(AIndex)]:=aValue;
diff --git a/packages/fcl-web/src/restbridge/sqldbrestmodule.pp b/packages/fcl-web/src/restbridge/sqldbrestmodule.pp
new file mode 100644
index 0000000000..0fb7cae15e
--- /dev/null
+++ b/packages/fcl-web/src/restbridge/sqldbrestmodule.pp
@@ -0,0 +1,78 @@
+unit sqldbrestmodule;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, httpdefs, fphttp, sqldbrestbridge;
+
+Type
+
+ { TSQLDBRestModule }
+
+ TSQLDBRestModule = Class (TSessionHTTPModule)
+ private
+ FDispatcher: TSQLDBRestDispatcher;
+ procedure SetDispatcher(AValue: TSQLDBRestDispatcher);
+ Protected
+ Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ Function FindDispatcher : TSQLDBRestDispatcher; virtual;
+ Public
+ constructor Create(AOwner: TComponent); override;
+ Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
+ Published
+ Property Dispatcher : TSQLDBRestDispatcher Read FDispatcher Write SetDispatcher;
+ Property Kind;
+ end;
+
+implementation
+
+uses sqldbrestconst;
+
+{ TSQLDBRestModule }
+
+procedure TSQLDBRestModule.SetDispatcher(AValue: TSQLDBRestDispatcher);
+begin
+ if FDispatcher=AValue then Exit;
+ if Assigned(Dispatcher) then
+ FDispatcher.RemoveFreeNotification(Self);
+ FDispatcher:=AValue;
+ if Assigned(Dispatcher) then
+ FDispatcher.FreeNotification(Self);
+end;
+
+procedure TSQLDBRestModule.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation=opRemove then
+ if AComponent=FDispatcher then
+ FDispatcher:=Nil;
+end;
+
+function TSQLDBRestModule.FindDispatcher: TSQLDBRestDispatcher;
+begin
+ Result:=Dispatcher;
+end;
+
+constructor TSQLDBRestModule.Create(AOwner: TComponent);
+begin
+ Kind:=wkOneShot;
+ inherited Create(AOwner);
+end;
+
+procedure TSQLDBRestModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+
+Var
+ Disp : TSQLDBRestDispatcher;
+
+begin
+ Disp:=FindDispatcher;
+ If assigned(Disp) then
+ Disp.HandleRequest(aRequest,aResponse)
+ else
+ Raise EHTTP.Create(SErrNoRESTDispatcher);
+end;
+
+end.
+
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index eec5b67e40..f40cf9ad53 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -520,6 +520,7 @@ const
nCantCallExtBracketAccessor = 4025;
nJSNewNotSupported = 4026;
nHelperClassMethodForExtClassMustBeStatic = 4027;
+ nBitWiseOperationIs32Bit = 4028;
// resourcestring patterns of messages
resourcestring
sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -549,6 +550,7 @@ resourcestring
sCantCallExtBracketAccessor = 'cannot call external bracket accessor, use a property instead';
sJSNewNotSupported = 'Pascal class does not support the "new" constructor';
sHelperClassMethodForExtClassMustBeStatic = 'Helper class method for external class must be static';
+ sBitWiseOperationIs32Bit = 'Bitwise operation is 32-bit';
const
ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -566,6 +568,9 @@ type
pbifnArray_Static_Clone,
pbifnAs,
pbifnAsExt,
+ pbifnBitwiseNativeIntAnd,
+ pbifnBitwiseNativeIntOr,
+ pbifnBitwiseNativeIntXor,
pbifnCheckMethodCall,
pbifnCheckVersion,
pbifnClassInstanceFree,
@@ -725,6 +730,9 @@ const
'$clone',
'as', // rtl.as
'asExt', // rtl.asExt
+ 'and', // pbifnBitwiseNativeIntAnd,
+ 'or', // pbifnBitwiseNativeIntOr,
+ 'xor', // pbifnBitwiseNativeIntXor,
'checkMethodCall',
'checkVersion',
'$destroy',
@@ -1167,7 +1175,7 @@ const
msArrayOperators,
msPrefixedAttributes,
msOmitRTTI,
- msMultipleScopeHelpers];
+ msMultiHelpers];
msAllPas2jsBoolSwitchesReadOnly = [
bsLongStrings
@@ -1436,6 +1444,7 @@ type
ScannerModeSwitches: TModeSwitches;
constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); virtual;
function GetRootModule: TPasModule;
+ function GetRootContext: TConvertContext;
function GetNonDotContext: TConvertContext;
function GetFunctionContext: TFunctionContext;
function GetLocalName(El: TPasElement): string; virtual;
@@ -1456,6 +1465,9 @@ type
TRootContext = Class(TConvertContext)
public
ResourceStrings: TJSVarDeclaration;
+ GlobalClassMethods: TArrayOfPasProcedure;
+ procedure AddGlobalClassMethod(p: TPasProcedure);
+ destructor Destroy; override;
end;
{ TFCLocalIdentifier }
@@ -1622,12 +1634,11 @@ type
{$ENDIF}
private
FGlobals: TPasToJSConverterGlobals;
- FGlobalClassMethods: TArrayOfPasProcedure;
FOnIsElementUsed: TPas2JSIsElementUsedEvent;
FOnIsTypeInfoUsed: TPas2JSIsElementUsedEvent;
FOptions: TPasToJsConverterOptions;
FReservedWords: TJSReservedWordList; // sorted with CompareStr
- Procedure AddGlobalClassMethod(P: TPasProcedure);
+ Procedure AddGlobalClassMethod(aContext: TConvertContext; P: TPasProcedure);
Function CreatePrimitiveDotExpr(Path: string; PosEl: TPasElement): TJSElement;
Function CreateSubDeclJSNameExpr(El: TPasElement; JSName: string;
AContext: TConvertContext; PosEl: TPasElement): TJSElement;
@@ -1874,7 +1885,7 @@ type
Function ConvertRepeatStatement(El: TPasImplRepeatUntil; AContext: TConvertContext): TJSElement; virtual;
Function ConvertForStatement(El: TPasImplForLoop; AContext: TConvertContext): TJSElement; virtual;
Function ConvertFinalizationSection(El: TFinalizationSection; AContext: TConvertContext): TJSElement; virtual;
- Function ConvertInitializationSection(El: TInitializationSection; AContext: TConvertContext): TJSElement; virtual;
+ Function ConvertInitializationSection(El: TPasModule; AContext: TConvertContext): TJSElement; virtual;
Function ConvertSimpleStatement(El: TPasImplSimple; AContext: TConvertContext): TJSElement; virtual;
Function ConvertWithStatement(El: TPasImplWithDo; AContext: TConvertContext): TJSElement; virtual;
Function ConvertTryStatement(El: TPasImplTry; AContext: TConvertContext ): TJSElement; virtual;
@@ -2128,6 +2139,23 @@ begin
Result:='['+Result+']';
end;
+{ TRootContext }
+
+procedure TRootContext.AddGlobalClassMethod(p: TPasProcedure);
+begin
+ {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
+ SetLength(GlobalClassMethods,length(GlobalClassMethods)+1);
+ GlobalClassMethods[length(GlobalClassMethods)-1]:=P;
+ {$ELSE}
+ Insert(P,GlobalClassMethods,length(GlobalClassMethods));
+ {$ENDIF}
+end;
+
+destructor TRootContext.Destroy;
+begin
+ inherited Destroy;
+end;
+
{ TPasToJSConverterGlobals }
constructor TPasToJSConverterGlobals.Create(TheOwner: TObject);
@@ -5831,6 +5859,13 @@ begin
Result:=nil;
end;
+function TConvertContext.GetRootContext: TConvertContext;
+begin
+ Result:=Self;
+ while Result.Parent<>nil do
+ Result:=Result.Parent;
+end;
+
function TConvertContext.GetNonDotContext: TConvertContext;
begin
Result:=Self;
@@ -6005,14 +6040,15 @@ begin
Result:=FGlobals.BuiltInNames[bin];
end;
-procedure TPasToJSConverter.AddGlobalClassMethod(P: TPasProcedure);
+procedure TPasToJSConverter.AddGlobalClassMethod(aContext: TConvertContext;
+ P: TPasProcedure);
+var
+ RootContext: TConvertContext;
begin
- {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
- SetLength(FGlobalClassMethods,length(FGlobalClassMethods)+1);
- FGlobalClassMethods[length(FGlobalClassMethods)-1]:=P;
- {$ELSE}
- Insert(P,FGlobalClassMethods,length(FGlobalClassMethods));
- {$ENDIF}
+ RootContext:=aContext.GetRootContext;
+ if not (RootContext is TRootContext) then
+ DoError(20190226232141,RootContext.ClassName);
+ TRootContext(RootContext).AddGlobalClassMethod(P);
end;
procedure TPasToJSConverter.AddToSourceElements(Src: TJSSourceElements;
@@ -6650,6 +6686,7 @@ var
ModeSwitches: TModeSwitches;
aResolver: TPas2JSResolver;
LeftTypeEl, RightTypeEl: TPasType;
+ OldAccess: TCtxAccess;
begin
Result:=Nil;
aResolver:=AContext.Resolver;
@@ -6668,14 +6705,8 @@ begin
end;
end;
- if AContext.Access<>caRead then
- begin
- {$IFDEF VerbosePas2JS}
- writeln('TPasToJSConverter.ConvertBinaryExpression OpCode=',El.OpCode,' AContext.Access=',AContext.Access);
- {$ENDIF}
- DoError(20170209152633,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El);
- end;
-
+ OldAccess:=AContext.Access;
+ AContext.Access:=caRead;
Call:=nil;
A:=ConvertExpression(El.left,AContext);
B:=nil;
@@ -6784,9 +6815,7 @@ begin
Result:=Call;
exit;
end;
- eopAnd,
- eopOr,
- eopXor:
+ eopAnd:
begin
if aResolver<>nil then
begin
@@ -6795,26 +6824,74 @@ begin
if UseBitwiseOp
and (LeftResolved.BaseType in [btIntDouble,btUIntDouble])
and (RightResolved.BaseType in [btIntDouble,btUIntDouble]) then
- aResolver.LogMsg(20190124233439,mtWarning,nBitWiseOperationsAre32Bit,
- sBitWiseOperationsAre32Bit,[],El);
+ begin
+ Call:=CreateCallExpression(El);
+ Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnBitwiseNativeIntAnd)]);
+ Call.AddArg(A);
+ Call.AddArg(B);
+ Result:=Call;
+ exit;
+ end;
end
else
UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
or (GetExpressionValueType(El.right,AContext)=jstNumber);
if UseBitwiseOp then
- Case El.OpCode of
- eopAnd : C:=TJSBitwiseAndExpression;
- eopOr : C:=TJSBitwiseOrExpression;
- eopXor : C:=TJSBitwiseXOrExpression;
+ C:=TJSBitwiseAndExpression
+ else
+ C:=TJSLogicalAndExpression;
+ end;
+ eopOr:
+ begin
+ if aResolver<>nil then
+ begin
+ UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
+ or (RightResolved.BaseType in btAllJSInteger));
+ if UseBitwiseOp
+ and ((LeftResolved.BaseType in [btIntDouble,btUIntDouble])
+ or (RightResolved.BaseType in [btIntDouble,btUIntDouble])) then
+ begin
+ Call:=CreateCallExpression(El);
+ Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnBitwiseNativeIntOr)]);
+ Call.AddArg(A);
+ Call.AddArg(B);
+ Result:=Call;
+ exit;
+ end;
end
else
- Case El.OpCode of
- eopAnd : C:=TJSLogicalAndExpression;
- eopOr : C:=TJSLogicalOrExpression;
- eopXor : C:=TJSBitwiseXOrExpression;
- else
- DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
- end;
+ UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
+ or (GetExpressionValueType(El.right,AContext)=jstNumber);
+ if UseBitwiseOp then
+ C:=TJSBitwiseOrExpression
+ else
+ C:=TJSLogicalOrExpression;
+ end;
+ eopXor:
+ begin
+ if aResolver<>nil then
+ begin
+ UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
+ or (RightResolved.BaseType in btAllJSInteger));
+ if UseBitwiseOp
+ and ((LeftResolved.BaseType in [btIntDouble,btUIntDouble])
+ or (RightResolved.BaseType in [btIntDouble,btUIntDouble])) then
+ begin
+ Call:=CreateCallExpression(El);
+ Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnBitwiseNativeIntXor)]);
+ Call.AddArg(A);
+ Call.AddArg(B);
+ Result:=Call;
+ exit;
+ end;
+ end
+ else
+ UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
+ or (GetExpressionValueType(El.right,AContext)=jstNumber);
+ if UseBitwiseOp then
+ C:=TJSBitwiseXOrExpression
+ else
+ C:=TJSBitwiseXOrExpression;
end;
eopPower:
begin
@@ -6823,7 +6900,7 @@ begin
Call.AddArg(A);
Call.AddArg(B);
Result:=Call;
- end
+ end;
else
if C=nil then
DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
@@ -6835,11 +6912,17 @@ begin
R.B:=B; B:=nil;
Result:=R;
- if El.OpCode=eopDiv then
+ case El.OpCode of
+ eopDiv:
begin
// convert "a div b" to "Math.floor(a/b)"
Result:=CreateMathFloor(El,Result);
end;
+ eopShl,eopShr:
+ if (aResolver<>nil) and (LeftResolved.BaseType in [btIntDouble,btUIntDouble]) then
+ aResolver.LogMsg(20190228220225,mtWarning,nBitWiseOperationIs32Bit,
+ sBitWiseOperationIs32Bit,[],El);
+ end;
if (bsOverflowChecks in AContext.ScannerBoolSwitches) and (aResolver<>nil) then
case El.OpCode of
@@ -6854,6 +6937,7 @@ begin
end;
end;
finally
+ AContext.Access:=OldAccess;
if Result=nil then
begin
A.Free;
@@ -12945,7 +13029,7 @@ begin
else if (C=TPasClassConstructor)
or (C=TPasClassDestructor) then
begin
- AddGlobalClassMethod(TPasProcedure(P));
+ AddGlobalClassMethod(AContext,TPasProcedure(P));
continue;
end;
NewEl:=ConvertProcedure(TPasProcedure(P),FuncContext);
@@ -14079,11 +14163,12 @@ begin
end;
end;
-function TPasToJSConverter.ConvertInitializationSection(
- El: TInitializationSection; AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertInitializationSection(El: TPasModule;
+ AContext: TConvertContext): TJSElement;
var
FDS: TJSFunctionDeclarationStatement;
FuncContext: TFunctionContext;
+ PosEl: TPasElement;
function CreateBody: TJSFunctionBody;
var
@@ -14093,12 +14178,12 @@ var
Result:=FuncDef.Body;
if Result=nil then
begin
- Result:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
+ Result:=TJSFunctionBody(CreateElement(TJSFunctionBody,PosEl));
FuncDef.Body:=Result;
- Result.A:=TJSSourceElements(CreateElement(TJSSourceElements, El));
+ Result.A:=TJSSourceElements(CreateElement(TJSSourceElements, PosEl));
end;
if FuncContext=nil then
- FuncContext:=TFunctionContext.Create(El,Result,AContext);
+ FuncContext:=TFunctionContext.Create(PosEl,Result,AContext);
end;
var
@@ -14109,65 +14194,80 @@ var
Scope: TPas2JSInitialFinalizationScope;
Line, Col: integer;
Lit: TJSLiteral;
+ Section: TInitializationSection;
+ RootContext: TRootContext;
begin
// create: '$mod.$init=function(){}'
Result:=nil;
- Scope:=TPas2JSInitialFinalizationScope(El.CustomData);
- IsMain:=(El.Parent<>nil) and (El.Parent is TPasProgram);
+ Section:=El.InitializationSection;
+ if Section<>nil then
+ begin
+ PosEl:=Section;
+ Scope:=TPas2JSInitialFinalizationScope(Section.CustomData);
+ end
+ else
+ begin
+ PosEl:=El;
+ Scope:=nil;
+ end;
+
+ IsMain:=(El is TPasProgram);
if IsMain then
FunName:=GetBIName(pbifnProgramMain)
else
FunName:=GetBIName(pbifnUnitInit);
NeedRTLCheckVersion:=IsMain and (coRTLVersionCheckMain in Options);
+ RootContext:=AContext.GetRootContext as TRootContext;
FuncContext:=nil;
- AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+ AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PosEl));
try
// $mod.$init =
AssignSt.LHS:=CreateMemberExpression([GetBIName(pbivnModule),FunName]);
// = function(){...}
- FDS:=CreateFunctionSt(El,false);
+ FDS:=CreateFunctionSt(PosEl,false);
AssignSt.Expr:=FDS;
Body:=FDS.AFunction.Body;
// first convert main/initialization statements
- if Scope.JS<>'' then
- begin
- S:=TrimRight(Scope.JS);
- if S<>'' then
+ if Section<>nil then
+ if Scope.JS<>'' then
+ begin
+ S:=TrimRight(Scope.JS);
+ if S<>'' then
+ begin
+ Body:=CreateBody;
+ // use precompiled JS
+ TPasResolver.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
+ Lit:=TJSLiteral.Create(Line,Col,El.SourceFilename);
+ Lit.Value.CustomValue:=StrToJSString(S);
+ Body.A:=Lit;
+ end;
+ end
+ else if Section.Elements.Count>0 then
begin
Body:=CreateBody;
- // use precompiled JS
- TPasResolver.UnmangleSourceLineNumber(El.Parent.SourceLinenumber,Line,Col);
- Lit:=TJSLiteral.Create(Line,Col,El.Parent.SourceFilename);
- Lit.Value.CustomValue:=StrToJSString(S);
- Body.A:=Lit;
- end;
- end
- else if El.Elements.Count>0 then
- begin
- Body:=CreateBody;
- // Note: although the rtl sets 'this' as the module, the function can
- // simply refer to $mod, so no need to set ThisPas here
- Body.A:=ConvertImplBlockElements(El,FuncContext,false);
- FuncContext.BodySt:=Body.A;
+ // Note: although the rtl sets 'this' as the module, the function can
+ // simply refer to $mod, so no need to set ThisPas here
+ Body.A:=ConvertImplBlockElements(Section,FuncContext,false);
+ FuncContext.BodySt:=Body.A;
- AddInterfaceReleases(FuncContext,El);
- Body.A:=FuncContext.BodySt;
+ AddInterfaceReleases(FuncContext,PosEl);
+ Body.A:=FuncContext.BodySt;
- // store precompiled JS
- if (coStoreImplJS in Options) and (AContext.Resolver<>nil) then
- begin
- Scope.JS:=TrimRight(CreatePrecompiledJS(Body.A));
- if Scope.JS='' then
- Scope.JS:=' '; // store the information, that there is an empty initialization section
- end;
- end
- else if (coStoreImplJS in Options) and (AContext.Resolver<>nil) then
- Scope.JS:=' '; // store the information, that there is an empty initialization section
+ // store precompiled JS
+ if (coStoreImplJS in Options) and (AContext.Resolver<>nil) then
+ begin
+ Scope.JS:=TrimRight(CreatePrecompiledJS(Body.A));
+ if Scope.JS='' then
+ Scope.JS:=' '; // store the information, that there is an empty initialization section
+ end;
+ end
+ else if (coStoreImplJS in Options) and (AContext.Resolver<>nil) then
+ Scope.JS:=' '; // store the information, that there is an empty initialization section
- if length(FGlobalClassMethods)>0 then
+ if length(RootContext.GlobalClassMethods)>0 then
begin
// prepend class constructors (which one depends on WPO)
Body:=CreateBody;
@@ -14588,10 +14688,14 @@ end;
procedure TPasToJSConverter.CreateInitSection(El: TPasModule;
Src: TJSSourceElements; AContext: TConvertContext);
+var
+ RootContext: TRootContext;
begin
+ RootContext:=AContext.GetRootContext as TRootContext;
// add initialization section
- if Assigned(El.InitializationSection) then
- AddToSourceElements(Src,ConvertInitializationSection(El.InitializationSection,AContext));
+ if Assigned(El.InitializationSection)
+ or (length(RootContext.GlobalClassMethods)>0) then
+ AddToSourceElements(Src,ConvertInitializationSection(El,AContext));
// finalization: not supported
if Assigned(El.FinalizationSection) then
raise Exception.Create('TPasToJSConverter.ConvertInitializationSection: finalization section is not supported');
@@ -15636,13 +15740,15 @@ var
St: TJSElement;
Call: TJSCallExpression;
Bracket: TJSUnaryBracketsExpression;
+ RootContext: TRootContext;
begin
+ RootContext:=TRootContext(FuncContext.GetRootContext);
First:=nil;
Last:=nil;
try
- for i:=0 to length(FGlobalClassMethods)-1 do
+ for i:=0 to length(RootContext.GlobalClassMethods)-1 do
begin
- Proc:=FGlobalClassMethods[i];
+ Proc:=RootContext.GlobalClassMethods[i];
St:=ConvertProcedure(Proc,FuncContext);
// create direct call ( function(){} )();
Bracket:=TJSUnaryBracketsExpression(CreateElement(TJSUnaryBracketsExpression,PosEl));
@@ -18090,7 +18196,7 @@ begin
// append args
ProcType:=Proc.ProcType;
- if Expr.Parent is TParamsExpr then
+ if (Expr.Parent is TParamsExpr) and (TParamsExpr(Expr.Parent).Value=Expr) then
ParamsExpr:=TParamsExpr(Expr.Parent)
else
ParamsExpr:=nil;
@@ -18232,7 +18338,7 @@ begin
else if (El.ClassType=TPasImplBeginBlock) then
Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,true)
else if (El.ClassType=TInitializationSection) then
- Result:=ConvertInitializationSection(TInitializationSection(El),AContext)
+ Result:=ConvertInitializationSection(TPasModule(El.Parent),AContext)
else if (El.ClassType=TFinalizationSection) then
Result:=ConvertFinalizationSection(TFinalizationSection(El),AContext)
else if (El.ClassType=TPasImplTry) then
@@ -21242,7 +21348,7 @@ begin
begin
// pass set with argDefault -> create reference rtl.refSet(right)
{$IFDEF VerbosePas2JS}
- writeln('TPasToJSConverter.CreateProcedureCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+ writeln('TPasToJSConverter.CreateProcCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
{$ENDIF}
Result:=CreateReferencedSet(El,Result);
end;
@@ -21320,7 +21426,7 @@ begin
begin
// pass record with argDefault -> "TGuid.$clone(RightRecord)"
{$IFDEF VerbosePas2JS}
- writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD TGuid variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+ writeln('TPasToJSConverter.CreateProcCallArg clone RECORD TGuid variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
{$ENDIF}
Result:=CreateRecordCallClone(El,TPasRecordType(ArgTypeEl),Result,AContext);
end;
@@ -21389,7 +21495,7 @@ begin
begin
// pass record with argDefault -> "RightRecord.$clone(RightRecord)"
{$IFDEF VerbosePas2JS}
- writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+ writeln('TPasToJSConverter.CreateProcCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
{$ENDIF}
Result:=CreateRecordCallClone(El,TPasRecordType(ExprTypeEl),Result,AContext);
end;
@@ -21500,6 +21606,7 @@ begin
ParamContext.Arg:=TargetArg;
ParamContext.Expr:=El;
ParamContext.ResolvedExpr:=ResolvedEl;
+ writeln('AAA1 TPasToJSConverter.CreateProcCallArgRef ',GetObjName(El));
FullGetter:=ConvertExpression(El,ParamContext);
// FullGetter is now a full JS expression to retrieve the value.
if ParamContext.ReusingReference then
@@ -21513,7 +21620,7 @@ begin
// ParamContext.Getter is the last part of the FullGetter
// FullSetter is created from FullGetter by replacing the Getter with the Setter
{$IFDEF VerbosePas2JS}
- writeln('TPasToJSConverter.CreateProcedureCallArg VAR FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter),' ',GetResolverResultDbg(ResolvedEl));
+ writeln('TPasToJSConverter.CreateProcCallArgRef VAR El=',GetObjName(El),' FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter),' ',GetResolverResultDbg(ResolvedEl));
{$ENDIF}
// create "{p:path,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}"
@@ -21657,12 +21764,23 @@ begin
end
else
begin
- {$IFDEF VerbosePas2JS}
- writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter));
- {$ENDIF}
- RaiseNotSupported(El,AContext,20170213230336);
+ // getter is the result of an operation
+
+ // create "p:FullGetter"
+ AddVar(TempRefParamName,FullGetter);
+ FullGetter:=nil;
+
+ // GetExpr "this.a"
+ GetExpr:=CreatePrimitiveDotExpr('this.'+TempRefParamName,El);
+
+ // SetExpr "raise EPropReadOnly"
+ SetExpr:=CreateRaisePropReadOnly(El);
end;
+ {$IFDEF VerbosePas2JS}
+ //writeln('TPasToJSConverter.CreateProcCallArgRef GetExpr=',GetObjName(GetExpr),' SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName);
+ {$ENDIF}
+
if (SetExpr.ClassType=TJSPrimaryExpressionIdent)
or (SetExpr.ClassType=TJSDotMemberExpression)
or (SetExpr.ClassType=TJSBracketMemberExpression) then
@@ -21717,6 +21835,10 @@ begin
else
RaiseInconsistency(20170213225940,El);
+ {$IFDEF VerbosePas2JS}
+ //writeln('TPasToJSConverter.CreateProcCallArgRef created full SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName);
+ {$ENDIF}
+
// add p:GetPathExpr
AddVar(TempRefGetPathName,GetPathExpr);
@@ -22231,7 +22353,7 @@ begin
begin
if (C=TPasClassConstructor)
or (C=TPasClassDestructor) then
- AddGlobalClassMethod(TPasProcedure(P))
+ AddGlobalClassMethod(AContext,TPasProcedure(P))
else
begin
Methods.Add(P);
diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp
index 7765dbfa91..509257cf6b 100644
--- a/packages/pastojs/src/pas2jscompiler.pp
+++ b/packages/pastojs/src/pas2jscompiler.pp
@@ -387,6 +387,7 @@ type
function ReadContinue: boolean; // true=finished
function ReaderState: TPas2jsReaderState;
procedure CreateJS;
+ procedure EmitModuleHints;
function GetPasFirstSection: TPasSection;
function GetPasImplSection: TPasSection;
function GetPasMainUsesClause: TPasUsesClause;
@@ -1479,13 +1480,6 @@ procedure TPas2jsCompilerFile.CreateJS;
begin
//writeln('TPas2jsCompilerFile.CreateJS START ',UnitFilename,' JS=',GetObjName(FJSModule));
try
- // show hints only for units that are actually converted
- if (PCUSupport=nil) or not PCUSupport.HasReader then
- begin
- //writeln('TPas2jsCompilerFile.CreateJS ',UnitFilename);
- UseAnalyzer.EmitModuleHints(PasModule);
- end;
-
// convert
CreateConverter;
Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
@@ -1505,6 +1499,27 @@ begin
//writeln('TPas2jsCompilerFile.CreateJS END ',UnitFilename,' JS=',GetObjName(FJSModule));
end;
+procedure TPas2jsCompilerFile.EmitModuleHints;
+begin
+ try
+ // show hints only for units with sources
+ if (PCUSupport=nil) or not PCUSupport.HasReader then
+ begin
+ //writeln('TPas2jsCompilerFile.EmitModuleHints ',UnitFilename);
+ UseAnalyzer.EmitModuleHints(PasModule);
+ end;
+ except
+ on E: ECompilerTerminate do
+ raise;
+ on E: Exception do
+ HandleException(E);
+ {$IFDEF pas2js}
+ else
+ HandleJSException('[20190226183324] TPas2jsCompilerFile.EmitModuleHints File="'+UnitFilename+'"',
+ JSExceptValue);
+ {$ENDIF}
+ end;
+end;
function TPas2jsCompilerFile.GetPasFirstSection: TPasSection;
var
@@ -1971,11 +1986,17 @@ procedure TPas2jsCompiler.CreateJavaScript(aFile: TPas2jsCompilerFile;
begin
//writeln('TPas2jsCompiler.CreateJavaScript ',aFile.UnitFilename,' JS=',GetObjName(aFile.JSModule),' Need=',aFile.NeedBuild);
- if (aFile.JSModule<>nil) or (not aFile.NeedBuild) then exit;
+ if aFile.JSModule<>nil then exit; // already created
+
// check each file only once
if Checked.ContainsItem(aFile) then exit;
Checked.Add(aFile);
+ // emit module hints
+ aFile.EmitModuleHints;
+
+ if not aFile.NeedBuild then exit;
+
Log.LogMsg(nCompilingFile,[FullFormatPath(aFile.UnitFilename)],'',0,0,
not (coShowLineNumbers in Options));
@@ -4307,7 +4328,7 @@ begin
if FHasShownLogo then exit;
FHasShownLogo:=true;
WriteVersionLine;
- Log.LogPlain('Copyright (c) 2018 Free Pascal team.');
+ Log.LogPlain('Copyright (c) 2019 Free Pascal team.');
if coShowInfos in Options then
WriteEncoding;
end;
diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp
index 521176152a..16bc5b93bd 100644
--- a/packages/pastojs/src/pas2jsfiler.pp
+++ b/packages/pastojs/src/pas2jsfiler.pp
@@ -172,7 +172,7 @@ const
'ExternalClass',
'PrefixedAttributes',
'OmitRTTI',
- 'MultipleScopeHelpers'
+ 'MultiHelpers'
); // Dont forget to update ModeSwitchToInt !
PCUDefaultBoolSwitches: TBoolSwitches = [
@@ -1047,6 +1047,9 @@ type
var
PrecompileFormats: TPas2JSPrecompileFormats = nil;
+ PCUFormat: TPas2JSPrecompileFormat = nil;
+
+procedure RegisterPCUFormat;
function ComparePointer(Data1, Data2: Pointer): integer;
function ComparePCUSrcFiles(File1, File2: Pointer): integer;
@@ -1073,6 +1076,12 @@ function dbgmem(p: PChar; Cnt: integer): string; overload;
implementation
+procedure RegisterPCUFormat;
+begin
+ if PCUFormat=nil then
+ PCUFormat:=PrecompileFormats.Add('pcu','all used pcu must match exactly',TPCUReader,TPCUWriter);
+end;
+
function ComparePointer(Data1, Data2: Pointer): integer;
begin
if Data1>Data2 then Result:=-1
@@ -1394,7 +1403,7 @@ begin
// msIgnoreInterfaces: Result:=46;
// msIgnoreAttributes: Result:=47;
msOmitRTTI: Result:=48;
- msMultipleScopeHelpers: Result:=49;
+ msMultiHelpers: Result:=49;
end;
end;
@@ -4954,6 +4963,8 @@ begin
begin
s:=Names[i];
Found:=false;
+ if (FileVersion<5) and (SameText(s,'multiplescopehelpers')) then
+ s:=PCUModeSwitchNames[msMultiHelpers];
for f in TModeSwitch do
if s=PCUModeSwitchNames[f] then
begin
@@ -7924,6 +7935,8 @@ end;
procedure TPas2JSPrecompileFormats.Clear;
begin
+ if (PCUFormat<>nil) and (FItems.IndexOf(PCUFormat)>=0) then
+ PCUFormat:=nil;
FItems.Clear;
end;
@@ -7995,7 +8008,6 @@ end;
initialization
PrecompileFormats:=TPas2JSPrecompileFormats.Create;
- PrecompileFormats.Add('pcu','all used pcu must match exactly',TPCUReader,TPCUWriter);
finalization
PrecompileFormats.Free;
PrecompileFormats:=nil;
diff --git a/packages/pastojs/src/pas2jspcucompiler.pp b/packages/pastojs/src/pas2jspcucompiler.pp
index e80e034649..012511b45c 100644
--- a/packages/pastojs/src/pas2jspcucompiler.pp
+++ b/packages/pastojs/src/pas2jspcucompiler.pp
@@ -402,11 +402,19 @@ Var
begin
if PrecompileFormats.Count>0 then
begin
- writeHelpLine(' -JU<x>: Create precompiled units in format x.');
- for i:=0 to PrecompileFormats.Count-1 do
- with PrecompileFormats[i] do
- writeHelpLine(' -JU'+Ext+': '+Description);
- writeHelpLine(' -JU-: Disable prior -JU<x> option. Do not create precompiled units.');
+ if PrecompileFormats.Count>1 then
+ begin
+ writeHelpLine(' -JU<x>: Create precompiled units in format x.');
+ for i:=0 to PrecompileFormats.Count-1 do
+ with PrecompileFormats[i] do
+ writeHelpLine(' -JU'+Ext+': '+Description);
+ writeHelpLine(' -JU-: Disable prior -JU<x> option. Do not create precompiled units.');
+ end else
+ begin
+ with PrecompileFormats[0] do
+ writeHelpLine(' -JU'+Ext+': Create precompiled units using '+Description);
+ writeHelpLine(' -JU- : Disable prior -JU<x> option. Do not create precompiled units.');
+ end;
end;
end;
diff --git a/packages/pastojs/tests/tcfiler.pas b/packages/pastojs/tests/tcfiler.pas
index 563c524858..966e3d6f2e 100644
--- a/packages/pastojs/tests/tcfiler.pas
+++ b/packages/pastojs/tests/tcfiler.pas
@@ -1646,6 +1646,7 @@ begin
' s = ''abc'';', // string lit
' c: char = s[1];', // array params
' a: array[1..2] of longint = (3,4);', // anonymous array, range, array values
+ ' PI: Double; external name ''Math.PI'';',
'resourcestring',
' rs = ''rs'';',
'implementation']);
@@ -1745,11 +1746,13 @@ procedure TTestPrecompile.TestPC_Record;
begin
StartUnit(false);
Add([
+ '{$ModeSwitch externalclass}',
'interface',
'type',
' TRec = record',
' i: longint;',
' s: string;',
+ ' b: boolean external name ''ext'';',
' end;',
' P = pointer;', // alias type to built-in type
' TArrOfRec = array of TRec;',
@@ -2359,5 +2362,6 @@ end;
Initialization
RegisterTests([TTestPrecompile]);
+ RegisterPCUFormat;
end.
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
index 54736a66e2..92f2a649cb 100644
--- a/packages/pastojs/tests/tcmodules.pas
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -263,7 +263,7 @@ type
Procedure TestInteger;
Procedure TestIntegerRange;
Procedure TestIntegerTypecasts;
- Procedure TestBitwiseAndNativeIntWarn;
+ Procedure TestBitwiseShlNativeIntWarn;
Procedure TestCurrency;
Procedure TestForBoolDo;
Procedure TestForIntDo;
@@ -473,7 +473,8 @@ type
Procedure TestAdvRecord_SubClass;
Procedure TestAdvRecord_SubInterfaceFail;
Procedure TestAdvRecord_Constructor;
- Procedure TestAdvRecord_ClassConstructor;
+ Procedure TestAdvRecord_ClassConstructor_Program;
+ Procedure TestAdvRecord_ClassConstructor_Unit;
// classes
Procedure TestClass_TObjectDefaultConstructor;
@@ -675,6 +676,7 @@ type
Procedure TestTypeHelper_ClassMethod;
Procedure TestTypeHelper_Constructor;
Procedure TestTypeHelper_Word;
+ Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_StringChar;
Procedure TestTypeHelper_Array;
Procedure TestTypeHelper_EnumType;
@@ -3079,24 +3081,36 @@ end;
procedure TTestModule.TestBitwiseOperators;
begin
StartProgram(false);
- Add('var');
- Add(' vA,vB,vC:longint;');
- Add('begin');
- Add(' va:=vb and vc;');
- Add(' va:=vb or vc;');
- Add(' va:=vb xor vc;');
- Add(' va:=vb shl vc;');
- Add(' va:=vb shr vc;');
- Add(' va:=3 and vc;');
- Add(' va:=(vb and vc) or (va and vb);');
- Add(' va:=not vb;');
+ Add([
+ 'var',
+ ' vA,vB,vC:longint;',
+ ' X,Y,Z: nativeint;',
+ 'begin',
+ ' va:=vb and vc;',
+ ' va:=vb or vc;',
+ ' va:=vb xor vc;',
+ ' va:=vb shl vc;',
+ ' va:=vb shr vc;',
+ ' va:=3 and vc;',
+ ' va:=(vb and vc) or (va and vb);',
+ ' va:=not vb;',
+ ' X:=Y and Z;',
+ ' X:=Y and va;',
+ ' X:=Y or Z;',
+ ' X:=Y or va;',
+ ' X:=Y xor Z;',
+ ' X:=Y xor va;',
+ '']);
ConvertProgram;
CheckSource('TestBitwiseOperators',
LinesToStr([ // statements
'this.vA = 0;',
'this.vB = 0;',
- 'this.vC = 0;'
- ]),
+ 'this.vC = 0;',
+ 'this.X = 0;',
+ 'this.Y = 0;',
+ 'this.Z = 0;',
+ '']),
LinesToStr([ // this.$main
'$mod.vA = $mod.vB & $mod.vC;',
'$mod.vA = $mod.vB | $mod.vC;',
@@ -3105,8 +3119,14 @@ begin
'$mod.vA = $mod.vB >>> $mod.vC;',
'$mod.vA = 3 & $mod.vC;',
'$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
- '$mod.vA = ~$mod.vB;'
- ]));
+ '$mod.vA = ~$mod.vB;',
+ '$mod.X = rtl.and($mod.Y, $mod.Z);',
+ '$mod.X = $mod.Y & $mod.vA;',
+ '$mod.X = rtl.or($mod.Y, $mod.Z);',
+ '$mod.X = rtl.or($mod.Y, $mod.vA);',
+ '$mod.X = rtl.xor($mod.Y, $mod.Z);',
+ '$mod.X = rtl.xor($mod.Y, $mod.vA);',
+ '']));
end;
procedure TTestModule.TestPrgProcVar;
@@ -6413,25 +6433,24 @@ begin
'']));
end;
-procedure TTestModule.TestBitwiseAndNativeIntWarn;
+procedure TTestModule.TestBitwiseShlNativeIntWarn;
begin
StartProgram(false);
Add([
'var',
- ' i,j: nativeint;',
+ ' i: nativeint;',
'begin',
- ' i:=i and j;',
+ ' i:=i shl 3;',
'']);
ConvertProgram;
- CheckSource('TestBitwiseAndNativeIntWarn',
+ CheckSource('TestBitwiseShlNativeIntWarn',
LinesToStr([
'this.i = 0;',
- 'this.j = 0;',
'']),
LinesToStr([
- '$mod.i = $mod.i & $mod.j;',
+ '$mod.i = $mod.i << 3;',
'']));
- CheckHint(mtWarning,nBitWiseOperationsAre32Bit,sBitWiseOperationsAre32Bit);
+ CheckHint(mtWarning,nBitWiseOperationIs32Bit,sBitWiseOperationIs32Bit);
end;
procedure TTestModule.TestCurrency;
@@ -11140,7 +11159,7 @@ begin
'']));
end;
-procedure TTestModule.TestAdvRecord_ClassConstructor;
+procedure TTestModule.TestAdvRecord_ClassConstructor_Program;
begin
StartProgram(false);
Add([
@@ -11168,7 +11187,7 @@ begin
' r.x:=10;',
'']);
ConvertProgram;
- CheckSource('TestAdvRecord_ClassConstructor',
+ CheckSource('TestAdvRecord_ClassConstructor_Program',
LinesToStr([ // statements
'rtl.recNewT($mod, "TPoint", function () {',
' this.x = 0;',
@@ -11196,6 +11215,62 @@ begin
'']));
end;
+procedure TTestModule.TestAdvRecord_ClassConstructor_Unit;
+begin
+ StartUnit(false);
+ Add([
+ 'interface',
+ '{$modeswitch AdvancedRecords}',
+ 'type',
+ ' TPoint = record',
+ ' class var x: longint;',
+ ' class procedure Fly; static;',
+ ' class constructor Init;',
+ ' end;',
+ 'implementation',
+ 'var count: word;',
+ 'class procedure Tpoint.Fly;',
+ 'begin',
+ 'end;',
+ 'class constructor tpoint.init;',
+ 'begin',
+ ' count:=count+1;',
+ ' x:=3;',
+ ' tpoint.x:=4;',
+ ' fly;',
+ ' tpoint.fly;',
+ 'end;',
+ '']);
+ ConvertUnit;
+ CheckSource('TestAdvRecord_ClassConstructor_Unit',
+ LinesToStr([ // statements
+ 'var $impl = $mod.$impl;',
+ 'rtl.recNewT($mod, "TPoint", function () {',
+ ' this.x = 0;',
+ ' this.$eq = function (b) {',
+ ' return true;',
+ ' };',
+ ' this.$assign = function (s) {',
+ ' return this;',
+ ' };',
+ ' this.Fly = function () {',
+ ' };',
+ '}, true);',
+ '']),
+ LinesToStr([ // $mod.$init
+ '(function () {',
+ ' $impl.count = $impl.count + 1;',
+ ' $mod.TPoint.x = 3;',
+ ' $mod.TPoint.x = 4;',
+ ' $mod.TPoint.Fly();',
+ ' $mod.TPoint.Fly();',
+ '})();',
+ '']),
+ LinesToStr([ // $mod.$main
+ '$impl.count = 0;',
+ '']));
+end;
+
procedure TTestModule.TestClass_TObjectDefaultConstructor;
begin
StartProgram(false);
@@ -22819,6 +22894,84 @@ begin
'']));
end;
+procedure TTestModule.TestTypeHelper_Double;
+begin
+ StartProgram(false);
+ Add([
+ '{$modeswitch typehelpers}',
+ 'type',
+ ' Float = type double;',
+ ' THelper = type helper for double',
+ ' const NPI = 3.141592;',
+ ' function ToStr: String;',
+ ' end;',
+ 'function THelper.ToStr: String;',
+ 'begin',
+ 'end;',
+ 'procedure DoIt(s: string);',
+ 'begin',
+ 'end;',
+ 'var f: Float;',
+ 'begin',
+ ' DoIt(f.toStr);',
+ ' DoIt(f.toStr());',
+ ' (f*f).toStr;',
+ ' DoIt((f*f).toStr);',
+ '']);
+ ConvertProgram;
+ CheckSource('TestTypeHelper_Double',
+ LinesToStr([ // statements
+ 'rtl.createHelper($mod, "THelper", null, function () {',
+ ' this.NPI = 3.141592;',
+ ' this.ToStr = function () {',
+ ' var Result = "";',
+ ' return Result;',
+ ' };',
+ '});',
+ 'this.DoIt = function (s) {',
+ '};',
+ 'this.f = 0.0;',
+ '']),
+ LinesToStr([ // $mod.$main
+ '$mod.DoIt($mod.THelper.ToStr.call({',
+ ' p: $mod,',
+ ' get: function () {',
+ ' return this.p.f;',
+ ' },',
+ ' set: function (v) {',
+ ' this.p.f = v;',
+ ' }',
+ '}));',
+ '$mod.DoIt($mod.THelper.ToStr.call({',
+ ' p: $mod,',
+ ' get: function () {',
+ ' return this.p.f;',
+ ' },',
+ ' set: function (v) {',
+ ' this.p.f = v;',
+ ' }',
+ '}));',
+ '$mod.THelper.ToStr.call({',
+ ' a: $mod.f * $mod.f,',
+ ' get: function () {',
+ ' return this.a;',
+ ' },',
+ ' set: function (v) {',
+ ' rtl.raiseE("EPropReadOnly");',
+ ' }',
+ '});',
+ '$mod.DoIt($mod.THelper.ToStr.call({',
+ ' a: $mod.f * $mod.f,',
+ ' get: function () {',
+ ' return this.a;',
+ ' },',
+ ' set: function (v) {',
+ ' rtl.raiseE("EPropReadOnly");',
+ ' }',
+ '}));',
+ '']));
+end;
+
procedure TTestModule.TestTypeHelper_StringChar;
begin
StartProgram(false);
diff --git a/packages/pastojs/tests/tcprecompile.pas b/packages/pastojs/tests/tcprecompile.pas
index a984dd5ca3..01c3027ae7 100644
--- a/packages/pastojs/tests/tcprecompile.pas
+++ b/packages/pastojs/tests/tcprecompile.pas
@@ -137,6 +137,10 @@ begin
if not CheckSrcDiff(OrigSrc,NewSrc,s) then
begin
WriteSources;
+ writeln('TCustomTestCLI_Precompile.CheckPrecompile OrigSrc==================');
+ writeln(OrigSrc);
+ writeln('TCustomTestCLI_Precompile.CheckPrecompile NewSrc==================');
+ writeln(NewSrc);
Fail('test1.js: '+s);
end;
end;
@@ -392,11 +396,14 @@ begin
' constructor Create;',
' end;',
' TBird = class',
- ' class constructor Init;',
+ ' class constructor InitBird;',
' end;',
''],[
'constructor TObject.Create; begin end;',
- 'class constructor TBird.Init; begin end;',
+ 'class constructor TBird.InitBird;',
+ 'begin',
+ ' exit;',
+ 'end;',
'']);
AddUnit('src/unit2.pp',[
'uses unit1;',
@@ -598,5 +605,6 @@ end;
Initialization
RegisterTests([TTestCLI_Precompile]);
+ RegisterPCUFormat;
end.
diff --git a/packages/rtl-objpas/src/i386/invoke.inc b/packages/rtl-objpas/src/i386/invoke.inc
new file mode 100644
index 0000000000..01b2400fe3
--- /dev/null
+++ b/packages/rtl-objpas/src/i386/invoke.inc
@@ -0,0 +1,445 @@
+{%MainUnit ../inc/rtti.pp}
+
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (C) 2019 Sven Barth
+ member of the Free Pascal development team.
+
+ Function call manager for i386
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+{$define SYSTEM_HAS_INVOKE}
+
+function ReturnResultInParam(aType: PTypeInfo): Boolean;
+var
+ td: PTypeData;
+begin
+ Result := False;
+ if Assigned(aType) then begin
+ case aType^.Kind of
+ tkMethod,
+ tkSString,
+ tkAString,
+ tkUString,
+ tkWString,
+ tkInterface,
+ tkDynArray:
+ Result := True;
+ tkArray: begin
+ td := GetTypeData(aType);
+ Result := not (td^.ArrayData.Size in [1, 2, 4]);
+ end;
+ tkRecord: begin
+ td := GetTypeData(aType);
+ Result := not (td^.RecSize in [1, 2, 4]);
+ end;
+ tkSet: begin
+ td := GetTypeData(aType);
+ case td^.OrdType of
+ otUByte:
+ Result := not (td^.SetSize in [1, 2, 4]);
+ otUWord,
+ otULong:
+ Result := False;
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure InvokeKernelRegister(aCodeAddress: CodePointer; aArgs: Pointer; aArgCount: LongInt); assembler; nostackframe;
+label
+ nostackargs;
+asm
+ pushl %ebp
+ movl %esp, %ebp
+
+ pushl %edi
+ pushl %esi
+
+ pushl %eax
+ pushl %edx
+
+ cmpl $3, %ecx
+ jle nostackargs
+
+ { copy arguments to stack }
+
+ subl $3, %ecx
+
+ { allocate count (%ecx) * 4 space on stack }
+ movl %ecx, %eax
+ shll $2, %eax
+
+ sub %eax, %esp
+
+ movl %esp, %edi
+
+ lea 12(%edx), %esi
+
+ cld
+ rep movsd
+
+nostackargs:
+
+ movl 8(%edx), %ecx
+ movl (%edx), %eax
+ movl 4(%edx), %edx
+
+ call -12(%ebp)
+
+ popl %ecx
+ movl %eax, (%ecx)
+ movl %edx, 4(%ecx)
+
+ popl %ecx
+
+ popl %esi
+ popl %edi
+
+ movl %ebp, %esp
+ popl %ebp
+end;
+
+resourcestring
+ SErrFailedToConvertArg = 'Failed to convert argument %d of type %s';
+
+procedure SystemInvokeRegister(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
+ aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
+type
+ PBoolean16 = ^Boolean16;
+ PBoolean32 = ^Boolean32;
+ PBoolean64 = ^Boolean64;
+ PByteBool = ^ByteBool;
+ PQWordBool = ^QWordBool;
+var
+ regstack: array of PtrUInt;
+ stackargs: array of SizeInt;
+ argcount, regidx, stackidx, stackcnt, i: LongInt;
+ retinparam, isstack: Boolean;
+ td: PTypeData;
+ floatres: Extended;
+
+ procedure AddRegArg(aValue: PtrUInt);
+ begin
+ if regidx < 3 then begin
+ regstack[regidx] := aValue;
+ Inc(regidx);
+ end else begin
+ if 3 + stackidx = Length(regstack) then
+ SetLength(regstack, Length(regstack) * 2);
+ regstack[3 + stackidx] := aValue;
+ Inc(stackidx);
+ end;
+ end;
+
+ procedure AddStackArg(aValue: PtrUInt);
+ begin
+ if 3 + stackidx = Length(regstack) then
+ SetLength(regstack, Length(regstack) * 2);
+ regstack[3 + stackidx] := aValue;
+ Inc(stackidx);
+ end;
+
+begin
+ { for the register calling convention we always have the registers EAX, EDX, ECX
+ and then the stack; if a parameter does not fit into a register its moved to the
+ next available stack slot and the next parameter gets a chance to be in a register }
+
+ retinparam := ReturnResultInParam(aResultType);
+
+ { we allocate at least three slots for EAX, ECX and EDX }
+ argcount := Length(aArgs);
+ if retinparam then
+ Inc(argcount);
+ if argcount < 3 then
+ SetLength(regstack, 3)
+ else
+ SetLength(regstack, argcount);
+
+ regidx := 0;
+ stackidx := 0;
+
+ SetLength(stackargs, Length(aArgs));
+ stackcnt := 0;
+
+ { first pass: handle register parameters }
+ for i := 0 to High(aArgs) do begin
+ if regidx >= 3 then begin
+ { all register locations already used up }
+ stackargs[stackcnt] := i;
+ Inc(stackcnt);
+ Continue;
+ end;
+
+ isstack := False;
+
+ if pfArray in aArgs[i].Info.ParamFlags then
+ AddRegArg(PtrUInt(aArgs[i].ValueRef))
+ else if aArgs[i].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
+ AddRegArg(PtrUInt(aArgs[i].ValueRef))
+ else begin
+ td := GetTypeData(aArgs[i].Info.ParamType);
+ case aArgs[i].Info.ParamType^.Kind of
+ tkSString,
+ tkMethod:
+ AddRegArg(PtrUInt(aArgs[i].ValueRef));
+ tkArray:
+ if td^.ArrayData.Size <= 4 then
+ isstack := True
+ else
+ AddRegArg(PtrUInt(aArgs[i].ValueRef));
+ tkRecord:
+ if td^.RecSize <= 4 then
+ isstack := True
+ else
+ AddRegArg(PtrUInt(aArgs[i].ValueRef));
+ tkObject,
+ tkWString,
+ tkUString,
+ tkAString,
+ tkDynArray,
+ tkClass,
+ tkClassRef,
+ tkInterface,
+ tkInterfaceRaw,
+ tkProcVar,
+ tkPointer:
+ AddRegArg(PPtrUInt(aArgs[i].ValueRef)^);
+ tkInt64,
+ tkQWord:
+ isstack := True;
+ tkSet: begin
+ case td^.OrdType of
+ otUByte: begin
+ case td^.SetSize of
+ 0, 1:
+ AddRegArg(PByte(aArgs[i].ValueRef)^);
+ 2:
+ AddRegArg(PWord(aArgs[i].ValueRef)^);
+ 3:
+ AddRegArg(PtrUInt(aArgs[i].ValueRef));
+ 4:
+ AddRegArg(PLongWord(aArgs[i].ValueRef)^);
+ else
+ AddRegArg(PtrUInt(aArgs[i].ValueRef));
+ end;
+ end;
+ otUWord:
+ AddRegArg(PWord(aArgs[i].ValueRef)^);
+ otULong:
+ AddRegArg(PLongWord(aArgs[i].ValueRef)^);
+ end;
+ end;
+ tkEnumeration,
+ tkInteger: begin
+ case td^.OrdType of
+ otSByte: AddRegArg(PShortInt(aArgs[i].ValueRef)^);
+ otUByte: AddRegArg(PByte(aArgs[i].ValueRef)^);
+ otSWord: AddRegArg(PSmallInt(aArgs[i].ValueRef)^);
+ otUWord: AddRegArg(PWord(aArgs[i].ValueRef)^);
+ otSLong: AddRegArg(PLongInt(aArgs[i].ValueRef)^);
+ otULong: AddRegArg(PLongWord(aArgs[i].ValueRef)^);
+ end;
+ end;
+ tkBool: begin
+ case td^.OrdType of
+ otUByte: AddRegArg(ShortInt(System.PBoolean(aArgs[i].ValueRef)^));
+ otUWord: AddRegArg(Byte(PBoolean16(aArgs[i].ValueRef)^));
+ otULong: AddRegArg(SmallInt(PBoolean32(aArgs[i].ValueRef)^));
+ otUQWord: isstack := True;
+ otSByte: AddRegArg(Word(PByteBool(aArgs[i].ValueRef)^));
+ otSWord: AddRegArg(LongInt(PWordBool(aArgs[i].ValueRef)^));
+ otSLong: AddRegArg(LongWord(PLongBool(aArgs[i].ValueRef)^));
+ otSQWord: isstack := True;
+ end;
+ end;
+ tkFloat:
+ { all float types are passed in on stack }
+ isstack := True;
+ else
+ raise EInvocationError.CreateFmt(SErrFailedToConvertArg, [i, aArgs[i].Info.ParamType^.Name]);
+ end;
+ end;
+
+ if isstack then begin
+ stackargs[stackcnt] := i;
+ Inc(stackcnt);
+ end;
+ end;
+
+ { then add the result parameter reference (if any) }
+ if Assigned(aResultType) and retinparam then
+ AddRegArg(PtrUInt(aResultValue));
+
+ { second pass: handle stack arguments from right to left }
+ if stackcnt > 0 then begin
+ for i := stackcnt - 1 downto 0 do begin
+ if pfArray in aArgs[stackargs[i]].Info.ParamFlags then
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
+ else if aArgs[stackargs[i]].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
+ else begin
+ td := GetTypeData(aArgs[stackargs[i]].Info.ParamType);
+ case aArgs[stackargs[i]].Info.ParamType^.Kind of
+ tkSString,
+ tkMethod:
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef));
+ tkArray:
+ if td^.ArrayData.Size <= 4 then
+ AddStackArg(PPtrUInt(aArgs[stackargs[i]].ValueRef)^)
+ else
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef));
+ tkRecord:
+ if td^.RecSize <= 4 then
+ AddStackArg(PPtrUInt(aArgs[stackargs[i]].ValueRef)^)
+ else
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef));
+ tkObject,
+ tkWString,
+ tkUString,
+ tkAString,
+ tkDynArray,
+ tkClass,
+ tkClassRef,
+ tkInterface,
+ tkInterfaceRaw,
+ tkProcVar,
+ tkPointer:
+ AddStackArg(PPtrUInt(aArgs[stackargs[i]].ValueRef)^);
+ tkInt64,
+ tkQWord: begin
+ AddStackArg(PInt32(PInt64(aArgs[stackargs[i]].ValueRef))[0]);
+ AddStackArg(PInt32(PInt64(aArgs[stackargs[i]].ValueRef))[1]);
+ end;
+ tkSet: begin
+ case td^.OrdType of
+ otUByte: begin
+ case td^.SetSize of
+ 0, 1:
+ AddStackArg(PByte(aArgs[stackargs[i]].ValueRef)^);
+ 2:
+ AddStackArg(PWord(aArgs[stackargs[i]].ValueRef)^);
+ 3:
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef));
+ 4:
+ AddStackArg(PLongWord(aArgs[stackargs[i]].ValueRef)^);
+ else
+ AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef));
+ end;
+ end;
+ otUWord:
+ AddStackArg(PWord(aArgs[stackargs[i]].ValueRef)^);
+ otULong:
+ AddStackArg(PLongWord(aArgs[stackargs[i]].ValueRef)^);
+ end;
+ end;
+ tkEnumeration,
+ tkInteger: begin
+ case td^.OrdType of
+ otSByte: AddStackArg(PShortInt(aArgs[stackargs[i]].ValueRef)^);
+ otUByte: AddStackArg(PByte(aArgs[stackargs[i]].ValueRef)^);
+ otSWord: AddStackArg(PSmallInt(aArgs[stackargs[i]].ValueRef)^);
+ otUWord: AddStackArg(PWord(aArgs[stackargs[i]].ValueRef)^);
+ otSLong: AddStackArg(PLongInt(aArgs[stackargs[i]].ValueRef)^);
+ otULong: AddStackArg(PLongWord(aArgs[stackargs[i]].ValueRef)^);
+ end;
+ end;
+ tkBool: begin
+ case td^.OrdType of
+ otUByte: AddStackArg(ShortInt(System.PBoolean(aArgs[stackargs[i]].ValueRef)^));
+ otUWord: AddStackArg(Byte(PBoolean16(aArgs[stackargs[i]].ValueRef)^));
+ otULong: AddStackArg(SmallInt(PBoolean32(aArgs[stackargs[i]].ValueRef)^));
+ otUQWord: AddStackArg(QWord(PBoolean64(aArgs[stackargs[i]].ValueRef)));
+ otSByte: AddStackArg(Word(PByteBool(aArgs[stackargs[i]].ValueRef)^));
+ otSWord: AddStackArg(LongInt(PWordBool(aArgs[stackargs[i]].ValueRef)^));
+ otSLong: AddStackArg(LongWord(PLongBool(aArgs[stackargs[i]].ValueRef)^));
+ otSQWord: AddStackArg(PtrUInt(PQWordBool(aArgs[stackargs[i]].ValueRef)));
+ end;
+ end;
+ tkFloat: begin
+ case td^.FloatType of
+ ftCurr : begin
+ AddStackArg(PInt32(PCurrency(aArgs[stackargs[i]].ValueRef))[0]);
+ AddStackArg(PInt32(PCurrency(aArgs[stackargs[i]].ValueRef))[1]);
+ end;
+ ftSingle : AddStackArg(PInt32(PSingle(aArgs[stackargs[i]].ValueRef))^);
+ ftDouble : begin
+ AddStackArg(PInt32(PDouble(aArgs[stackargs[i]].ValueRef))[0]);
+ AddStackArg(PInt32(PDouble(aArgs[stackargs[i]].ValueRef))[1]);
+ end;
+ ftExtended: begin
+ AddStackArg(PInt32(PExtended(aArgs[stackargs[i]].ValueRef))[0]);
+ AddStackArg(PInt32(PExtended(aArgs[stackargs[i]].ValueRef))[1]);
+ AddStackArg(PWord(PExtended(aArgs[stackargs[i]].ValueRef))[4]);
+ end;
+ ftComp : begin
+ AddStackArg(PInt32(PComp(aArgs[stackargs[i]].ValueRef))[0]);
+ AddStackArg(PInt32(PComp(aArgs[stackargs[i]].ValueRef))[1]);
+ end;
+ end;
+ end;
+ else
+ raise EInvocationError.CreateFmt(SErrFailedToConvertArg, [stackargs[i], aArgs[stackargs[i]].Info.ParamType^.Name]);
+ end;
+ end;
+ end;
+ end;
+
+ InvokeKernelRegister(aCodeAddress, @regstack[0], 3 + stackidx);
+
+ if Assigned(aResultType) and not retinparam then begin
+ if aResultType^.Kind = tkFloat then begin
+ td := GetTypeData(aResultType);
+ asm
+ lea floatres, %eax
+ fstpt (%eax)
+ end ['eax'];
+ case td^.FloatType of
+ ftSingle:
+ PSingle(aResultValue)^ := floatres;
+ ftDouble:
+ PDouble(aResultValue)^ := floatres;
+ ftExtended:
+ PExtended(aResultValue)^ := floatres;
+ ftCurr:
+ PCurrency(aResultValue)^ := floatres / 10000;
+ ftComp:
+ PComp(aResultValue)^ := floatres;
+ end;
+ end else if aResultType^.Kind in [tkQWord, tkInt64] then
+ PQWord(aResultValue)^ := regstack[0] or (QWord(regstack[1]) shl 32)
+ else
+ PPtrUInt(aResultValue)^ := regstack[0];
+ end;
+end;
+
+procedure SystemInvoke(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
+ aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
+begin
+ case aCallConv of
+ ccReg:
+ SystemInvokeRegister(aCodeAddress, aArgs, aCallConv, aResultType, aResultValue, aFlags);
+ otherwise
+ Assert(False, 'Unsupported calling convention');
+ end;
+end;
+
+const
+ SystemFunctionCallManager: TFunctionCallManager = (
+ Invoke: @SystemInvoke;
+ CreateCallbackProc: Nil;
+ CreateCallbackMethod: Nil;
+ );
+
+procedure InitSystemFunctionCallManager;
+begin
+ SetFunctionCallManager([ccReg{, ccCdecl, ccPascal, ccStdCall}], SystemFunctionCallManager);
+end;
diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp
index d1e42241fa..82449f426d 100644
--- a/packages/rtl-objpas/src/inc/rtti.pp
+++ b/packages/rtl-objpas/src/inc/rtti.pp
@@ -3552,7 +3552,7 @@ begin
end;}
{$ifndef InLazIDE}
-{$if defined(CPUX86_64) and defined(WIN64)}
+{$if defined(CPUI386) or (defined(CPUX86_64) and defined(WIN64))}
{$I invoke.inc}
{$endif}
{$endif}
diff --git a/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp b/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp
index 90ddc3b891..fc5d6a48d8 100644
--- a/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp
+++ b/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp
@@ -8,6 +8,8 @@ program testrunner.rtlobjpas;
{.$define useffi}
{$if defined(CPUX64) and defined(WINDOWS)}
{$define testinvoke}
+{$elseif defined(CPUI386)}
+{$define testinvoke}
{$else}
{$ifdef useffi}
{$define testinvoke}
diff --git a/packages/rtl-objpas/tests/tests.rtti.util.pas b/packages/rtl-objpas/tests/tests.rtti.util.pas
index 358a32894b..da780e8e56 100644
--- a/packages/rtl-objpas/tests/tests.rtti.util.pas
+++ b/packages/rtl-objpas/tests/tests.rtti.util.pas
@@ -37,7 +37,7 @@ function GetArray(const aArg: array of SizeInt): TValue;
implementation
uses
- TypInfo, SysUtils;
+ TypInfo, SysUtils, Math;
{$ifndef fpc}
function TValueHelper.AsUnicodeString: UnicodeString;
@@ -124,10 +124,12 @@ begin
Result := False
else begin
case td1^.FloatType of
- ftSingle,
- ftDouble,
+ ftSingle:
+ Result := SameValue(Single(aValue1.AsExtended), Single(aValue2.AsExtended));
+ ftDouble:
+ Result := SameValue(Double(aValue1.AsExtended), Double(aValue2.AsExtended));
ftExtended:
- Result := aValue1.AsExtended = aValue2.AsExtended;
+ Result := SameValue(aValue1.AsExtended, aValue2.AsExtended);
ftComp:
Result := aValue1.AsInt64 = aValue2.AsInt64;
ftCurr:
diff --git a/rtl/android/cwstring.pp b/rtl/android/cwstring.pp
index ee65eb0d11..ff9607bfc9 100644
--- a/rtl/android/cwstring.pp
+++ b/rtl/android/cwstring.pp
@@ -67,19 +67,19 @@ threadvar
function MaskExceptions: dword;
begin
-{$ifdef cpux86_64}
+{$if defined(cpux86_64) or defined(cpui386)}
Result:=GetMXCSR;
SetMXCSR(Result or %0000000010000000 {MM_MaskInvalidOp} or %0001000000000000 {MM_MaskPrecision});
{$else}
Result:=0;
-{$endif cpux86_64}
+{$endif}
end;
procedure UnmaskExceptions(oldmask: dword);
begin
-{$ifdef cpux86_64}
+{$if defined(cpux86_64) or defined(cpui386)}
SetMXCSR(oldmask);
-{$endif cpux86_64}
+{$endif}
end;
function OpenConverter(const name: ansistring): PUConverter;
diff --git a/tests/webtbf/tw35149a.pp b/tests/webtbf/tw35149a.pp
new file mode 100644
index 0000000000..b0cab6c482
--- /dev/null
+++ b/tests/webtbf/tw35149a.pp
@@ -0,0 +1,14 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}
+type
+ TestObject = object
+ var
+ TestNested: Integer;
+ end;
+
+begin
+ writeln(TestObject.TestNested);
+end.
diff --git a/tests/webtbs/tw35149.pp b/tests/webtbs/tw35149.pp
new file mode 100644
index 0000000000..1247969f8c
--- /dev/null
+++ b/tests/webtbs/tw35149.pp
@@ -0,0 +1,14 @@
+{ %norun }
+
+program project1;
+
+{$mode objfpc}
+type
+ TestObject = object
+ var
+ TestNested: Integer;
+ end;
+
+begin
+ writeln(SizeOf(TestObject.TestNested));
+end.
diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js
index 894467b7dc..010ff80fe9 100644
--- a/utils/pas2js/dist/rtl.js
+++ b/utils/pas2js/dist/rtl.js
@@ -1065,6 +1065,30 @@ var rtl = {
return 0;
},
+ and: function(a,b){
+ var hi = 0x80000000;
+ var low = 0x7fffffff;
+ var h = (a / hi) & (b / hi);
+ var l = (a & low) & (b & low);
+ return h*hi + l;
+ },
+
+ or: function(a,b){
+ var hi = 0x80000000;
+ var low = 0x7fffffff;
+ var h = (a / hi) | (b / hi);
+ var l = (a & low) | (b & low);
+ return h*hi + l;
+ },
+
+ xor: function(a,b){
+ var hi = 0x80000000;
+ var low = 0x7fffffff;
+ var h = (a / hi) ^ (b / hi);
+ var l = (a & low) ^ (b & low);
+ return h*hi + l;
+ },
+
initRTTI: function(){
if (rtl.debug_rtti) rtl.debug('initRTTI');
diff --git a/utils/pas2js/docs/translation.html b/utils/pas2js/docs/translation.html
index 02a69ed425..0255bbf544 100644
--- a/utils/pas2js/docs/translation.html
+++ b/utils/pas2js/docs/translation.html
@@ -1868,7 +1868,7 @@ function(){
If there are multiple helpers for the same type, the last helper in scope wins.<br>
A class with ancestors can have one active helper per ancestor type, so
multiple helpers can be active, same as FPC/Delphi.<br>
- Using <b>{$modeswitch multiplescopehelpers}</b> you can activate all helpers
+ Using <b>{$modeswitch multihelpers}</b> you can activate all helpers
within scope.
</li>
<li>Nested helpers (e.g. <i>TDemo.TSub.THelper</i>) are elevated.