* don't allow stringconst+integer

  * change booleans in arraydef to set
  * set option in arraydef to indicate a constant string so
    a nicer type can be shown instead of array[0..x] of char

git-svn-id: trunk@3051 -

.gitattributes

@@ -6020,6 +6020,7 @@ tests/webtbf/tw4781a.pp svneol=native#text/plain
 tests/webtbf/tw4781b.pp svneol=native#text/plain
 tests/webtbf/tw4893d.pp svneol=native#text/plain
 tests/webtbf/tw4893e.pp svneol=native#text/plain
+tests/webtbf/tw4911.pp svneol=native#text/plain
 tests/webtbf/tw4913.pp -text
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain

compiler/dbgdwarf.pas

@@ -904,7 +904,7 @@ implementation
               DW_AT_stride_size,DW_FORM_udata,def.elesize*8
               ]);
           append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementtype.def));
-          if def.IsDynamicArray then
+          if is_dynamic_array(def) then
             begin
               { !!! FIXME !!! }
               { gdb's dwarf implementation sucks, so we can't use DW_OP_push_object here (FK)

compiler/defutil.pas

@@ -463,16 +463,16 @@ implementation
     { true, if p points to a zero based array def }
     function is_zero_based_array(p : tdef) : boolean;
       begin
-         is_zero_based_array:=(p.deftype=arraydef) and
-                              (tarraydef(p).lowrange=0) and
-                              not(is_special_array(p));
+         result:=(p.deftype=arraydef) and
+                 (tarraydef(p).lowrange=0) and
+                 not(is_special_array(p));
       end;
 
     { true if p points to a dynamic array def }
     function is_dynamic_array(p : tdef) : boolean;
       begin
-         is_dynamic_array:=(p.deftype=arraydef) and
-           tarraydef(p).IsDynamicArray;
+         result:=(p.deftype=arraydef) and
+                 (ado_IsDynamicArray in tarraydef(p).arrayoptions);
       end;
 
 
@@ -481,48 +481,42 @@ implementation
       begin
          { check for s32inttype is needed, because for u32bit the high
            range is also -1 ! (PFV) }
-         is_open_array:=(p.deftype=arraydef) and
-                        (tarraydef(p).rangetype.def=s32inttype.def) and
-                        (tarraydef(p).lowrange=0) and
-                        (tarraydef(p).highrange=-1) and
-                        not(tarraydef(p).IsConstructor) and
-                        not(tarraydef(p).IsVariant) and
-                        not(tarraydef(p).IsArrayOfConst) and
-                        not(tarraydef(p).IsDynamicArray);
-
+         result:=(p.deftype=arraydef) and
+                 (tarraydef(p).rangetype.def=s32inttype.def) and
+                 (tarraydef(p).lowrange=0) and
+                 (tarraydef(p).highrange=-1) and
+                 ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
       end;
 
     { true, if p points to an array of const def }
     function is_array_constructor(p : tdef) : boolean;
       begin
-         is_array_constructor:=(p.deftype=arraydef) and
-                        (tarraydef(p).IsConstructor);
+         result:=(p.deftype=arraydef) and
+                 (ado_IsConstructor in tarraydef(p).arrayoptions);
       end;
 
     { true, if p points to a variant array }
     function is_variant_array(p : tdef) : boolean;
       begin
-         is_variant_array:=(p.deftype=arraydef) and
-                        (tarraydef(p).IsVariant);
+         result:=(p.deftype=arraydef) and
+                 (ado_IsVariant in tarraydef(p).arrayoptions);
       end;
 
     { true, if p points to an array of const }
     function is_array_of_const(p : tdef) : boolean;
       begin
-         is_array_of_const:=(p.deftype=arraydef) and
-                        (tarraydef(p).IsArrayOfConst);
+         result:=(p.deftype=arraydef) and
+                 (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
       end;
 
     { true, if p points to a special array }
     function is_special_array(p : tdef) : boolean;
       begin
-         is_special_array:=(p.deftype=arraydef) and
-                        ((tarraydef(p).IsVariant) or
-                         (tarraydef(p).IsArrayOfConst) or
-                         (tarraydef(p).IsConstructor) or
-                         (tarraydef(p).IsDynamicArray) or
-                         is_open_array(p)
-                        );
+         result:=(p.deftype=arraydef) and
+                 (
+                  ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or
+                  is_open_array(p)
+                 );
       end;
 
     { true if p is an ansi string def }

compiler/htypechk.pas

@@ -1404,8 +1404,8 @@ implementation
             begin
               { set can also be a not yet converted array constructor }
               if (p.resulttype.def.deftype=arraydef) and
-                 (tarraydef(p.resulttype.def).IsConstructor) and
-                 not(tarraydef(p.resulttype.def).IsVariant) then
+                 is_array_constructor(p.resulttype.def) and
+                 not is_variant_array(p.resulttype.def) then
                 eq:=te_equal;
             end;
           procvardef :

compiler/nadd.pas

@@ -1393,7 +1393,8 @@ implementation
 
          { this is a little bit dangerous, also the left type }
          { pointer to should be checked! This broke the mmx support      }
-         else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then
+         else if (rd.deftype=pointerdef) or
+                 (is_zero_based_array(rd) and (rt<>stringconstn)) then
           begin
             if is_zero_based_array(rd) then
               begin
@@ -1419,7 +1420,8 @@ implementation
               CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
           end
 
-         else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then
+         else if (ld.deftype=pointerdef) or
+                 (is_zero_based_array(ld) and (lt<>stringconstn)) then
            begin
              if is_zero_based_array(ld) then
                begin
@@ -1769,7 +1771,7 @@ implementation
               todefsigned) and
              (v >= low(longint)) and
              (v <= high(longint))
-          else            
+          else
             result :=
              (qword(v) >= low(cardinal)) and
              (qword(v) <= high(cardinal))

compiler/ncgld.pas

@@ -749,7 +749,7 @@ implementation
         tmpreg  : tregister;
         paraloc : tcgparalocation;
       begin
-        dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
+        dovariant:=(nf_forcevaria in flags) or is_variant_array(resulttype.def);
         if dovariant then
           elesize:=sizeof(aint)+sizeof(aint)
         else

compiler/ncon.pas

@@ -649,6 +649,7 @@ implementation
                 l:=0;
               resulttype.setdef(tarraydef.create(0,l,s32inttype));
               tarraydef(resulttype.def).setelementtype(cchartype);
+              include(tarraydef(resulttype.def).arrayoptions,ado_IsConstString);
             end;
           cst_shortstring :
             resulttype:=cshortstringtype;

compiler/nld.pas

@@ -887,8 +887,9 @@ implementation
            htype:=voidtype;
          resulttype.setdef(tarraydef.create(0,len-1,s32inttype));
          tarraydef(resulttype.def).setelementtype(htype);
-         tarraydef(resulttype.def).IsConstructor:=true;
-         tarraydef(resulttype.def).IsVariant:=varia;
+         include(tarraydef(resulttype.def).arrayoptions,ado_IsConstructor);
+         if varia then
+           include(tarraydef(resulttype.def).arrayoptions,ado_IsVariant);
       end;
 
 
@@ -897,8 +898,8 @@ implementation
         hp : tarrayconstructornode;
       begin
         tarraydef(resulttype.def).setelementtype(tt);
-        tarraydef(resulttype.def).IsConstructor:=true;
-        tarraydef(resulttype.def).IsVariant:=false;
+        include(tarraydef(resulttype.def).arrayoptions,ado_IsConstructor);
+        exclude(tarraydef(resulttype.def).arrayoptions,ado_IsVariant);
         if assigned(left) then
          begin
            hp:=self;
@@ -918,7 +919,7 @@ implementation
       begin
         if (iscvarargs) then
           include(flags,nf_cvarargs);
-        dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant or iscvarargs;
+        dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions) or iscvarargs;
         { only pass left tree, right tree contains next construct if any }
         if assigned(left) then
          begin
@@ -1006,7 +1007,7 @@ implementation
         hp : tarrayconstructornode;
         do_variant:boolean;
       begin
-        do_variant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
+        do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions);
         result:=nil;
         { Insert required type convs, this must be
           done in pass 1, because the call must be

compiler/pdecsub.pas

@@ -348,13 +348,13 @@ implementation
            case vartype.def.deftype of
              arraydef :
                begin
-                 with tarraydef(vartype.def) do
-                   if IsVariant or IsConstructor then
-                     begin
-                       Message1(parser_w_not_supported_for_inline,'array of const');
-                       Message(parser_w_inlining_disabled);
-                       pd.proccalloption:=pocall_default;
-                     end;
+                 if is_array_constructor(vartype.def) or
+                    is_variant_array(vartype.def) then
+                   begin
+                     Message1(parser_w_not_supported_for_inline,'array of const');
+                     Message(parser_w_inlining_disabled);
+                     pd.proccalloption:=pocall_default;
+                   end;
                end;
            end;
          end;
@@ -507,7 +507,7 @@ implementation
                    consume(_CONST);
                    srsym:=search_system_type('TVARREC');
                    tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
-                   tarraydef(tt.def).IsArrayOfConst:=true;
+                   include(tarraydef(tt.def).arrayoptions,ado_IsArrayOfConst);
                  end
                 else
                  begin

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=55;
+  CurrentPPUVersion=56;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/ptype.pas

@@ -542,7 +542,7 @@ implementation
            else
              begin
                 ap:=tarraydef.create(0,-1,s32inttype);
-                ap.IsDynamicArray:=true;
+                include(ap.arrayoptions,ado_IsDynamicArray);
                 tt.setdef(ap);
              end;
            consume(_OF);

compiler/symconst.pas

@@ -295,6 +295,16 @@ type
   );
   tobjectoptions=set of tobjectoption;
 
+  tarraydefoption=(ado_none,
+    ado_IsConvertedPointer,
+    ado_IsDynamicArray,
+    ado_IsVariant,
+    ado_IsConstructor,
+    ado_IsArrayOfConst,
+    ado_IsConstString
+  );
+  tarraydefoptions=set of tarraydefoption;
+
   { options for properties }
   tpropertyoption=(ppo_none,
     ppo_indexed,

compiler/symdef.pas

@@ -327,11 +327,7 @@ interface
           lowrange,
           highrange  : aint;
           rangetype  : ttype;
-          IsConvertedPointer,
-          IsDynamicArray,
-          IsVariant,
-          IsConstructor,
-          IsArrayOfConst : boolean;
+          arrayoptions : tarraydefoptions;
        protected
           _elementtype : ttype;
        public
@@ -2394,18 +2390,14 @@ implementation
          highrange:=h;
          rangetype:=t;
          elementtype.reset;
-         IsVariant:=false;
-         IsConstructor:=false;
-         IsArrayOfConst:=false;
-         IsDynamicArray:=false;
-         IsConvertedPointer:=false;
+         arrayoptions:=[];
       end;
 
 
     constructor tarraydef.create_from_pointer(const elemt : ttype);
       begin
          self.create(0,$7fffffff,s32inttype);
-         IsConvertedPointer:=true;
+         arrayoptions:=[ado_IsConvertedPointer];
          setelementtype(elemt);
       end;
 
@@ -2418,21 +2410,14 @@ implementation
          ppufile.gettype(rangetype);
          lowrange:=ppufile.getaint;
          highrange:=ppufile.getaint;
-         IsArrayOfConst:=boolean(ppufile.getbyte);
-         IsDynamicArray:=boolean(ppufile.getbyte);
-         IsVariant:=false;
-         IsConstructor:=false;
+         ppufile.getsmallset(arrayoptions);
       end;
 
 
     function tarraydef.getcopy : tstoreddef;
       begin
         result:=tarraydef.create(lowrange,highrange,rangetype);
-        tarraydef(result).IsConvertedPointer:=IsConvertedPointer;
-        tarraydef(result).IsDynamicArray:=IsDynamicArray;
-        tarraydef(result).IsVariant:=IsVariant;
-        tarraydef(result).IsConstructor:=IsConstructor;
-        tarraydef(result).IsArrayOfConst:=IsArrayOfConst;
+        tarraydef(result).arrayoptions:=arrayoptions;
         tarraydef(result)._elementtype:=_elementtype;
       end;
 
@@ -2460,8 +2445,7 @@ implementation
          ppufile.puttype(rangetype);
          ppufile.putaint(lowrange);
          ppufile.putaint(highrange);
-         ppufile.putbyte(byte(IsArrayOfConst));
-         ppufile.putbyte(byte(IsDynamicArray));
+         ppufile.putsmallset(arrayoptions);
          ppufile.writeentry(ibarraydef);
       end;
 
@@ -2476,7 +2460,7 @@ implementation
       var
         qhigh,qlow : qword;
       begin
-        if IsDynamicArray then
+        if ado_IsDynamicArray in arrayoptions then
           begin
             result:=0;
             exit;
@@ -2501,7 +2485,7 @@ implementation
         cachedelecount,
         cachedelesize : aint;
       begin
-        if IsDynamicArray then
+        if ado_IsDynamicArray in arrayoptions then
           begin
             size:=sizeof(aint);
             exit;
@@ -2529,8 +2513,8 @@ implementation
     procedure tarraydef.setelementtype(t: ttype);
       begin
         _elementtype:=t;
-       if not(IsDynamicArray or
-              IsConvertedPointer or
+       if not((ado_IsDynamicArray in arrayoptions) or
+              (ado_IsConvertedPointer in arrayoptions) or
               (highrange<lowrange)) then
          begin
            if (size=-1) then
@@ -2553,7 +2537,7 @@ implementation
 
     function tarraydef.needs_inittable : boolean;
       begin
-         needs_inittable:=IsDynamicArray or elementtype.def.needs_inittable;
+         needs_inittable:=(ado_IsDynamicArray in arrayoptions) or elementtype.def.needs_inittable;
       end;
 
 
@@ -2565,7 +2549,7 @@ implementation
 
     procedure tarraydef.write_rtti_data(rt:trttitype);
       begin
-         if IsDynamicArray then
+         if ado_IsDynamicArray in arrayoptions then
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray))
          else
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
@@ -2575,7 +2559,7 @@ implementation
 {$endif cpurequiresproperalignment}
          { size of elements }
          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(elesize));
-         if not(IsDynamicArray) then
+         if not(ado_IsDynamicArray in arrayoptions) then
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(elecount));
          { element type }
          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt)));
@@ -2586,14 +2570,17 @@ implementation
 
     function tarraydef.gettypename : string;
       begin
-         if isarrayofconst or isConstructor then
+         if (ado_IsConstString in arrayoptions) then
+           result:='Constant String'
+         else if (ado_isarrayofconst in arrayoptions) or
+                 (ado_isConstructor in arrayoptions) then
            begin
-             if isvariant or ((highrange=-1) and (lowrange=0)) then
+             if (ado_isvariant in arrayoptions) or ((highrange=-1) and (lowrange=0)) then
                gettypename:='Array Of Const'
              else
                gettypename:='Array Of '+elementtype.def.typename;
            end
-         else if ((highrange=-1) and (lowrange=0)) or IsDynamicArray then
+         else if ((highrange=-1) and (lowrange=0)) or (ado_IsDynamicArray in arrayoptions) then
            gettypename:='Array Of '+elementtype.def.typename
          else
            begin
@@ -2608,7 +2595,7 @@ implementation
 
     function tarraydef.getmangledparaname : string;
       begin
-         if isarrayofconst then
+         if ado_isarrayofconst in arrayoptions then
           getmangledparaname:='array_of_const'
          else
           if ((highrange=-1) and (lowrange=0)) then

compiler/symsym.pas

@@ -1260,7 +1260,7 @@ implementation
       begin
         if assigned(vartype.def) and
            ((vartype.def.deftype<>arraydef) or
-            tarraydef(vartype.def).isDynamicArray or
+            is_dynamic_array(vartype.def) or
             (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then
           result:=vartype.def.size
         else

compiler/utils/ppudump.pp

@@ -1135,6 +1135,116 @@ begin
 end;
 
 
+procedure readobjectdefoptions;
+type
+  tobjectoption=(oo_none,
+    oo_is_forward,         { the class is only a forward declared yet }
+    oo_has_virtual,        { the object/class has virtual methods }
+    oo_has_private,
+    oo_has_protected,
+    oo_has_strictprivate,
+    oo_has_strictprotected,
+    oo_has_constructor,    { the object/class has a constructor }
+    oo_has_destructor,     { the object/class has a destructor }
+    oo_has_vmt,            { the object/class has a vmt }
+    oo_has_msgstr,
+    oo_has_msgint,
+    oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
+    oo_has_default_property
+  );
+  tobjectoptions=set of tobjectoption;
+  tsymopt=record
+    mask : tobjectoption;
+    str  : string[30];
+  end;
+const
+  symopts=13;
+  symopt : array[1..symopts] of tsymopt=(
+     (mask:oo_has_virtual;        str:'IsForward'),
+     (mask:oo_has_virtual;        str:'HasVirtual'),
+     (mask:oo_has_private;        str:'HasPrivate'),
+     (mask:oo_has_protected;      str:'HasProtected'),
+     (mask:oo_has_strictprivate;  str:'HasStrictPrivate'),
+     (mask:oo_has_strictprotected;str:'HasStrictProtected'),
+     (mask:oo_has_constructor;    str:'HasConstructor'),
+     (mask:oo_has_destructor;     str:'HasDestructor'),
+     (mask:oo_has_vmt;            str:'HasVMT'),
+     (mask:oo_has_msgstr;         str:'HasMsgStr'),
+     (mask:oo_has_msgint;         str:'HasMsgInt'),
+     (mask:oo_can_have_published; str:'CanHavePublished'),
+     (mask:oo_has_default_property;str:'HasDefaultProperty')
+  );
+var
+  symoptions : tobjectoptions;
+  i      : longint;
+  first  : boolean;
+begin
+  ppufile.getsmallset(symoptions);
+  if symoptions<>[] then
+   begin
+     first:=true;
+     for i:=1to symopts do
+      if (symopt[i].mask in symoptions) then
+       begin
+         if first then
+           first:=false
+         else
+           write(', ');
+         write(symopt[i].str);
+       end;
+   end;
+  writeln;
+end;
+
+
+procedure readarraydefoptions;
+type
+  tarraydefoption=(ado_none,
+    ado_IsConvertedPointer,
+    ado_IsDynamicArray,
+    ado_IsVariant,
+    ado_IsConstructor,
+    ado_IsArrayOfConst,
+    ado_IsConstString
+  );
+  tarraydefoptions=set of tarraydefoption;
+  tsymopt=record
+    mask : tarraydefoption;
+    str  : string[30];
+  end;
+const
+  symopts=6;
+  symopt : array[1..symopts] of tsymopt=(
+     (mask:ado_IsConvertedPointer;str:'ConvertedPointer'),
+     (mask:ado_IsDynamicArray;    str:'IsDynamicArray'),
+     (mask:ado_IsVariant;         str:'IsVariant'),
+     (mask:ado_IsConstructor;     str:'IsConstructor'),
+     (mask:ado_IsArrayOfConst;    str:'ArrayOfConst'),
+     (mask:ado_IsConstString;     str:'ConstString')
+  );
+var
+  symoptions : tarraydefoptions;
+  i      : longint;
+  first  : boolean;
+begin
+  ppufile.getsmallset(symoptions);
+  if symoptions<>[] then
+   begin
+     first:=true;
+     for i:=1to symopts do
+      if (symopt[i].mask in symoptions) then
+       begin
+         if first then
+           first:=false
+         else
+           write(', ');
+         write(symopt[i].str);
+       end;
+   end;
+  writeln;
+end;
+
+
 procedure readnodetree;
 var
   l : longint;
@@ -1558,8 +1668,8 @@ begin
              write  (space,'       Range Type : ');
              readtype;
              writeln(space,'            Range : ',getlongint,' to ',getlongint);
-             writeln(space,'   Is Constructor : ',(getbyte<>0));
-             writeln(space,'       Is Dynamic : ',(getbyte<>0));
+             write  (space,'          Options : ');
+             readarraydefoptions;
            end;
 
          ibprocdef :
@@ -1682,9 +1792,10 @@ begin
              writeln(space,'       FieldAlign : ',getbyte);
              writeln(space,'      RecordAlign : ',getbyte);
              writeln(space,'       Vmt offset : ',getlongint);
-             write(space,  '   Ancestor Class : ');
+             write  (space,  '   Ancestor Class : ');
              readderef;
-             writeln(space,'          Options : ',getlongint);
+             write  (space,'          Options : ');
+             readobjectdefoptions;
 
              if tobjectdeftype(b) in [odt_interfacecom,odt_interfacecorba] then
                begin
@@ -1872,6 +1983,9 @@ begin
          iblinkothersharedlibs :
            ReadLinkContainer('Link other shared lib: ');
 
+         iblinkdlls :
+           ReadLinkContainer('Link DLLs: ');
+
          ibderefdata :
            ReadDerefData;
 

tests/webtbf/tw4911.pp

@@ -0,0 +1,15 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 4911 }
+{ Submitted by "Joost van der Sluis" on  2006-03-17 }
+{ e-mail: joost at cnoc - nl }
+program LongintTest;
+
+{$mode objfpc}{$H+}
+
+var l : longint;
+begin
+//l :=  335544569;  Gives an exception in my case
+  l :=  43;         // results garbage
+  writeln('Errpr: ' + l);
+end.