فهرست منبع

* fixed public/export support for initialised variables/typed
constants (mantis #9113)

git-svn-id: trunk@7772 -

Jonas Maebe 18 سال پیش
والد
کامیت
20a35f9701
7فایلهای تغییر یافته به همراه206 افزوده شده و 142 حذف شده
  1. 3 0
      .gitattributes
  2. 0 1
      compiler/pdecl.pas
  3. 134 125
      compiler/pdecvar.pas
  4. 33 16
      compiler/ptconst.pas
  5. 20 0
      tests/webtbs/tw9113.pp
  6. 8 0
      tests/webtbs/uw9113a.pp
  7. 8 0
      tests/webtbs/uw9113b.pp

+ 3 - 0
.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

+ 0 - 1
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;
 

+ 134 - 125
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

+ 33 - 16
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.

+ 20 - 0
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.
+

+ 8 - 0
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.

+ 8 - 0
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.