From 20a35f9701f333608ff182a8e9ff6cb9216cb417 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Fri, 22 Jun 2007 17:10:15 +0000 Subject: [PATCH] * fixed public/export support for initialised variables/typed constants (mantis #9113) git-svn-id: trunk@7772 - --- .gitattributes | 3 + compiler/pdecl.pas | 1 - compiler/pdecvar.pas | 259 +++++++++++++++++++++------------------- compiler/ptconst.pas | 49 +++++--- tests/webtbs/tw9113.pp | 20 ++++ tests/webtbs/uw9113a.pp | 8 ++ tests/webtbs/uw9113b.pp | 8 ++ 7 files changed, 206 insertions(+), 142 deletions(-) create mode 100644 tests/webtbs/tw9113.pp create mode 100644 tests/webtbs/uw9113a.pp create mode 100644 tests/webtbs/uw9113b.pp diff --git a/.gitattributes b/.gitattributes index ecc136e575..fe97315d9a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8308,6 +8308,7 @@ tests/webtbs/tw9076a.pp svneol=native#text/plain tests/webtbs/tw9085.pp svneol=native#text/plain tests/webtbs/tw9098.pp svneol=native#text/plain tests/webtbs/tw9107.pp svneol=native#text/plain +tests/webtbs/tw9113.pp svneol=native#text/plain tests/webtbs/tw9128.pp svneol=native#text/plain tests/webtbs/ub1873.pp svneol=native#text/plain tests/webtbs/ub1883.pp svneol=native#text/plain @@ -8359,6 +8360,8 @@ tests/webtbs/uw6767.pp svneol=native#text/plain tests/webtbs/uw7381.pp svneol=native#text/plain tests/webtbs/uw8180.pp svneol=native#text/plain tests/webtbs/uw8372.pp svneol=native#text/plain +tests/webtbs/uw9113a.pp svneol=native#text/plain +tests/webtbs/uw9113b.pp svneol=native#text/plain utils/Makefile svneol=native#text/plain utils/Makefile.fpc svneol=native#text/plain utils/README -text diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index f157c51068..e85cbae3fd 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -242,7 +242,6 @@ implementation else tclist:=current_asmdata.asmlists[al_typedconsts]; read_typed_const(tclist,tstaticvarsym(sym)); - consume(_SEMICOLON); end; end; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 66824615b1..691fa0e13d 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -39,6 +39,7 @@ interface procedure read_record_fields(options:Tvar_dec_options); + procedure read_public_and_external(vs: tabstractvarsym); implementation @@ -701,6 +702,137 @@ implementation const variantrecordlevel : longint = 0; + + procedure read_public_and_external_sc(sc:TFPObjectList); + var + vs: tabstractvarsym; + begin + { only allowed for one var } + vs:=tabstractvarsym(sc[0]); + if sc.count>1 then + Message(parser_e_absolute_only_one_var); + read_public_and_external(vs); + end; + + + procedure read_public_and_external(vs: tabstractvarsym); + var + is_dll, + is_cdecl, + is_external_var, + is_public_var : boolean; + dll_name, + C_name : string; + begin + { only allowed for one var } + { only allow external and public on global symbols } + if vs.typ<>staticvarsym then + begin + Message(parser_e_no_local_var_external); + exit; + end; + { defaults } + is_dll:=false; + is_cdecl:=false; + is_external_var:=false; + is_public_var:=false; + C_name:=vs.realname; + + { macpas specific handling due to some switches} + if (m_mac in current_settings.modeswitches) then + begin + if (cs_external_var in current_settings.localswitches) then + begin {The effect of this is the same as if cvar; external; has been given as directives.} + is_cdecl:=true; + is_external_var:=true; + end + else if (cs_externally_visible in current_settings.localswitches) then + begin {The effect of this is the same as if cvar has been given as directives and it's made public.} + is_cdecl:=true; + is_public_var:=true; + end; + end; + + { cdecl } + if try_to_consume(_CVAR) then + begin + consume(_SEMICOLON); + is_cdecl:=true; + end; + + { external } + if try_to_consume(_EXTERNAL) then + begin + is_external_var:=true; + if not is_cdecl then + begin + if idtoken<>_NAME then + begin + is_dll:=true; + dll_name:=get_stringconst; + if ExtractFileExt(dll_name)='' then + dll_name:=ChangeFileExt(dll_name,target_info.sharedlibext); + end; + if try_to_consume(_NAME) then + C_name:=get_stringconst; + end; + consume(_SEMICOLON); + end; + + { export or public } + if idtoken in [_EXPORT,_PUBLIC] then + begin + consume(_ID); + if is_external_var then + Message(parser_e_not_external_and_export) + else + is_public_var:=true; + if try_to_consume(_NAME) then + C_name:=get_stringconst; + consume(_SEMICOLON); + end; + + { Windows uses an indirect reference using import tables } + if is_dll and + (target_info.system in system_all_windows) then + include(vs.varoptions,vo_is_dll_var); + + { Add C _ prefix } + if is_cdecl or + ( + is_dll and + (target_info.system in systems_darwin) + ) then + C_Name := target_info.Cprefix+C_Name; + + if is_public_var then + begin + include(vs.varoptions,vo_is_public); + vs.varregable := vr_none; + { mark as referenced } + inc(vs.refs); + end; + + { now we can insert it in the import lib if its a dll, or + add it to the externals } + if is_external_var then + begin + if vo_is_typed_const in vs.varoptions then + Message(parser_e_initialized_not_for_external); + include(vs.varoptions,vo_is_external); + vs.varregable := vr_none; + if is_dll then + current_module.AddExternalImport(dll_name,C_Name,0,true) + else + if tf_has_dllscanner in target_info.flags then + current_module.dllscannerinputlist.Add(vs.mangledname,vs); + end; + + { Set the assembler name } + tstaticvarsym(vs).set_mangledname(C_Name); + end; + + procedure read_var_decls(options:Tvar_dec_options); procedure read_default_value(sc : TFPObjectList); @@ -858,127 +990,6 @@ implementation end; end; - procedure read_public_and_external(sc:TFPObjectList); - var - vs : tabstractvarsym; - is_dll, - is_cdecl, - is_external_var, - is_public_var : boolean; - dll_name, - C_name : string; - begin - { only allowed for one var } - vs:=tabstractvarsym(sc[0]); - if sc.count>1 then - Message(parser_e_absolute_only_one_var); - { only allow external and public on global symbols } - if vs.typ<>staticvarsym then - begin - Message(parser_e_no_local_var_external); - exit; - end; - { defaults } - is_dll:=false; - is_cdecl:=false; - is_external_var:=false; - is_public_var:=false; - C_name:=vs.realname; - - { macpas specific handling due to some switches} - if (m_mac in current_settings.modeswitches) then - begin - if (cs_external_var in current_settings.localswitches) then - begin {The effect of this is the same as if cvar; external; has been given as directives.} - is_cdecl:=true; - is_external_var:=true; - end - else if (cs_externally_visible in current_settings.localswitches) then - begin {The effect of this is the same as if cvar has been given as directives and it's made public.} - is_cdecl:=true; - is_public_var:=true; - end; - end; - - { cdecl } - if try_to_consume(_CVAR) then - begin - consume(_SEMICOLON); - is_cdecl:=true; - end; - - { external } - if try_to_consume(_EXTERNAL) then - begin - is_external_var:=true; - if not is_cdecl then - begin - if idtoken<>_NAME then - begin - is_dll:=true; - dll_name:=get_stringconst; - if ExtractFileExt(dll_name)='' then - dll_name:=ChangeFileExt(dll_name,target_info.sharedlibext); - end; - if try_to_consume(_NAME) then - C_name:=get_stringconst; - end; - consume(_SEMICOLON); - end; - - { export or public } - if idtoken in [_EXPORT,_PUBLIC] then - begin - consume(_ID); - if is_external_var then - Message(parser_e_not_external_and_export) - else - is_public_var:=true; - if try_to_consume(_NAME) then - C_name:=get_stringconst; - consume(_SEMICOLON); - end; - - { Windows uses an indirect reference using import tables } - if is_dll and - (target_info.system in system_all_windows) then - include(vs.varoptions,vo_is_dll_var); - - { Add C _ prefix } - if is_cdecl or - ( - is_dll and - (target_info.system in systems_darwin) - ) then - C_Name := target_info.Cprefix+C_Name; - - if is_public_var then - begin - include(vs.varoptions,vo_is_public); - vs.varregable := vr_none; - { mark as referenced } - inc(vs.refs); - end; - - { now we can insert it in the import lib if its a dll, or - add it to the externals } - if is_external_var then - begin - if vo_is_typed_const in vs.varoptions then - Message(parser_e_initialized_not_for_external); - include(vs.varoptions,vo_is_external); - vs.varregable := vr_none; - if is_dll then - current_module.AddExternalImport(dll_name,C_Name,0,true) - else - if tf_has_dllscanner in target_info.flags then - current_module.dllscannerinputlist.Add(vs.mangledname,vs); - end; - - { Set the assembler name } - tstaticvarsym(vs).set_mangledname(C_Name); - end; - var sc : TFPObjectList; vs : tabstractvarsym; @@ -1059,7 +1070,7 @@ implementation { Check for EXTERNAL etc directives before a semicolon } if (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then begin - read_public_and_external(sc); + read_public_and_external_sc(sc); allowdefaultvalue:=false; semicoloneaten:=true; end; @@ -1084,7 +1095,6 @@ implementation (hdef.typesym=nil) then handle_calling_convention(tprocvardef(hdef)); read_default_value(sc); - consume(_SEMICOLON); hasdefaultvalue:=true; end else @@ -1108,7 +1118,6 @@ implementation (symtablestack.top.symtabletype<>parasymtable) then begin read_default_value(sc); - consume(_SEMICOLON); hasdefaultvalue:=true; end; end; @@ -1127,7 +1136,7 @@ implementation ) ) ) then - read_public_and_external(sc); + read_public_and_external_sc(sc); { allocate normal variable (non-external and non-typed-const) staticvarsyms } for i:=0 to sc.count-1 do diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 36f4b0724a..883f7b6b7c 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -42,7 +42,7 @@ implementation node,htypechk,procinfo, nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw, { parser specific stuff } - pbase,pexpr, + pbase,pexpr,pdecvar, { codegen } cpuinfo,cgbase,dbgbase ; @@ -1303,6 +1303,7 @@ implementation storefilepos : tfileposinfo; cursectype : TAsmSectionType; C_name : string; + valuelist : tasmlist; begin { mark the staticvarsym as typedconst } include(sym.varoptions,vo_is_typed_const); @@ -1319,6 +1320,33 @@ implementation else cursectype:=sec_data; maybe_new_object_file(list); + valuelist:=tasmlist.create; + read_typed_const_data(valuelist,sym.vardef); + + { Parse hints } + try_consume_hintdirective(sym.symoptions); + + consume(_SEMICOLON); + + { parse public/external/export/... } + if ( + ( + (token = _ID) and + (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and + (m_cvar_support in current_settings.modeswitches) + ) or + ( + (m_mac in current_settings.modeswitches) and + ( + (cs_external_var in current_settings.localswitches) or + (cs_externally_visible in current_settings.localswitches) + ) + ) + ) then + read_public_and_external(sym); + + { only now add items based on the symbolname, because it may } + { have been modified by the directives parsed above } new_section(list,cursectype,lower(sym.mangledname),const_align(sym.vardef.alignment)); if (sym.owner.symtabletype=globalsymtable) or maybe_smartlink_symbol or @@ -1328,23 +1356,12 @@ implementation list.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,0)) else list.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,0)); - read_typed_const_data(list,sym.vardef); + + { add the parsed value } + list.concatlist(valuelist); + valuelist.free; list.concat(tai_symbol_end.Createname(sym.mangledname)); current_filepos:=storefilepos; - - { Parse hints } - try_consume_hintdirective(sym.symoptions); - - { Support public name directive } - if try_to_consume(_PUBLIC) then - begin - include(sym.varoptions,vo_is_public); - if try_to_consume(_NAME) then - C_name:=get_stringconst - else - C_name:=sym.realname; - sym.set_mangledname(C_Name); - end; end; end. diff --git a/tests/webtbs/tw9113.pp b/tests/webtbs/tw9113.pp new file mode 100644 index 0000000000..15a3a96930 --- /dev/null +++ b/tests/webtbs/tw9113.pp @@ -0,0 +1,20 @@ +uses uw9113a, uw9113b; + +var + v1: smallint; cvar; external; + myv2: smallint; external name '_v2'; + myv3: smallint; external name '_v3'; + v4: smallint; cvar; external; + myv5: smallint; external name '_v5'; + myv6: smallint; external name '_v6'; + +begin + if (v1 <> 1) or + (myv2 <> 2) or + (myv3 <> 3) or + (v4 <> 4) or + (myv5 <> 5) or + (myv6 <> 6) then + halt(1); +end. + diff --git a/tests/webtbs/uw9113a.pp b/tests/webtbs/uw9113a.pp new file mode 100644 index 0000000000..4987685265 --- /dev/null +++ b/tests/webtbs/uw9113a.pp @@ -0,0 +1,8 @@ +unit uw9113a; +interface +var + v1: integer = 1; cvar; + v2: integer = 2; export name '_v2'; + v3: integer = 3; public name '_v3'; +implementation +end. diff --git a/tests/webtbs/uw9113b.pp b/tests/webtbs/uw9113b.pp new file mode 100644 index 0000000000..451f0022fd --- /dev/null +++ b/tests/webtbs/uw9113b.pp @@ -0,0 +1,8 @@ +{$mode macpas} +unit uw9113b; +interface +var + v4: integer = 4; cvar; + v5: integer = 5; export name '_v5'; + v6: integer = 6; public name '_v6'; +end.