Merged revision(s) 44172, 44188, 45457 - 45458, 45645, 46218, 46953 from trunk:

r46953
* fix for Mantis #37806: allow undefineddefs for Include() and Exclude() + added tests
---------------------
r46218
* fix for Mantis #37187: inside generics the constant code in pexpr does not handle all cases and thus current_procinfo needs to be checked as well + added test
---------------------
r45645
* correctly set the generic related defoptions for an outlined procdef
---------------------
r45458
  * make more use of is_typeparam
---------------------
r45457
  * constrained type parameters are not undefined defs, resolves #37107
---------------------
r44188
* keep track of the fileposinfo for generic constraints
---------------------
r44172
* only resolve a dummy symbol if it is a type symbol (thus truly a dummy symbol) + added tests
---------------------

git-svn-id: branches/fixes_3_2@47802 -

.gitattributes

@@ -12930,8 +12930,11 @@ tests/tbs/tb0659g.pp svneol=native#text/pascal
 tests/tbs/tb0665.pp svneol=native#text/pascal
 tests/tbs/tb0666a.pp svneol=native#text/pascal
 tests/tbs/tb0666b.pp svneol=native#text/pascal
+tests/tbs/tb0668a.pp svneol=native#text/pascal
+tests/tbs/tb0668b.pp svneol=native#text/pascal
 tests/tbs/tb0669.pp svneol=native#text/pascal
 tests/tbs/tb0676.pp svneol=native#text/pascal
+tests/tbs/tb0677.pp svneol=native#text/pascal
 tests/tbs/tb0678.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
@@ -17770,7 +17773,9 @@ tests/webtbs/tw3708.pp svneol=native#text/plain
 tests/webtbs/tw37085.pp svneol=native#text/pascal
 tests/webtbs/tw37095.pp svneol=native#text/plain
 tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
+tests/webtbs/tw37107.pp svneol=native#text/pascal
 tests/webtbs/tw37154.pp svneol=native#text/pascal
+tests/webtbs/tw37187.pp svneol=native#text/pascal
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
 tests/webtbs/tw37218.pp svneol=native#text/pascal
@@ -17792,6 +17797,7 @@ tests/webtbs/tw3774.pp svneol=native#text/plain
 tests/webtbs/tw3777.pp svneol=native#text/plain
 tests/webtbs/tw3778.pp svneol=native#text/plain
 tests/webtbs/tw3780.pp svneol=native#text/plain
+tests/webtbs/tw37806.pp svneol=native#text/pascal
 tests/webtbs/tw3782.pp svneol=native#text/plain
 tests/webtbs/tw37949.pp svneol=native#text/pascal
 tests/webtbs/tw3796.pp svneol=native#text/plain

compiler/defutil.pas

@@ -1687,7 +1687,7 @@ implementation
 
     function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
       begin
-        result:=(def.typ=undefineddef);
+        result:=(def.typ=undefineddef) or (df_genconstraint in def.defoptions);
       end;
 
 

compiler/ninl.pas

@@ -725,7 +725,7 @@ implementation
           readfunctype:=nil;
 
           { can't read/write types }
-          if (para.left.nodetype=typen) and not(ttypenode(para.left).typedef.typ=undefineddef) then
+          if (para.left.nodetype=typen) and not(is_typeparam(ttypenode(para.left).typedef)) then
             begin
               CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
               error_para := true;
@@ -742,126 +742,124 @@ implementation
           if inlinenumber in [in_write_x,in_writeln_x] then
             { prefer strings to chararrays }
             maybe_convert_to_string(para.left);
-
+          if is_typeparam(para.left.resultdef) then
-          case para.left.resultdef.typ of
+            error_para:=true
-            stringdef :
+          else
-              name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
+            case para.left.resultdef.typ of
-            pointerdef :
+              stringdef :
-              begin
+                name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
-                if (not is_pchar(para.left.resultdef)) or do_read then
+              pointerdef :
-                  begin
+                begin
-                    CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
+                  if (not is_pchar(para.left.resultdef)) or do_read then
-                    error_para := true;
-                  end
-                else
-                  name:=procprefixes[do_read]+'pchar_as_pointer';
-              end;
-            floatdef :
-              begin
-                is_real:=true;
-                if Tfloatdef(para.left.resultdef).floattype=s64currency then
-                  name := procprefixes[do_read]+'currency'
-                else
-                  begin
-                    name := procprefixes[do_read]+'float';
-                    readfunctype:=pbestrealtype^;
-                  end;
-                { iso pascal needs a different handler }
-                if (m_isolike_io in current_settings.modeswitches) and do_read then
-                  name:=name+'_iso';
-              end;
-            enumdef:
-              begin
-                name:=procprefixes[do_read]+'enum';
-                readfunctype:=s32inttype;
-              end;
-            orddef :
-              begin
-                case Torddef(para.left.resultdef).ordtype of
-                  s8bit,
-                  s16bit,
-                  s32bit,
-                  s64bit,
-                  u8bit,
-                  u16bit,
-                  u32bit,
-                  u64bit:
                     begin
-                      get_read_write_int_func(para.left.resultdef,func_suffix,readfunctype);
+                      CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
-                      name := procprefixes[do_read]+func_suffix;
+                      error_para := true;
-                      if (m_isolike_io in current_settings.modeswitches) and do_read then
+                    end
-                        name:=name+'_iso';
+                  else
-                    end;
+                    name:=procprefixes[do_read]+'pchar_as_pointer';
-                  uchar :
+                end;
+              floatdef :
+                begin
+                  is_real:=true;
+                  if Tfloatdef(para.left.resultdef).floattype=s64currency then
+                    name := procprefixes[do_read]+'currency'
+                  else
                     begin
-                      name := procprefixes[do_read]+'char';
+                      name := procprefixes[do_read]+'float';
-                      { iso pascal needs a different handler }
+                      readfunctype:=pbestrealtype^;
-                      if (m_isolike_io in current_settings.modeswitches) and do_read then
-                        name:=name+'_iso';
-                      readfunctype:=cansichartype;
                     end;
-                  uwidechar :
+                  { iso pascal needs a different handler }
-                    begin
+                  if (m_isolike_io in current_settings.modeswitches) and do_read then
-                      name := procprefixes[do_read]+'widechar';
+                    name:=name+'_iso';
-                      readfunctype:=cwidechartype;
+                end;
-                    end;
+              enumdef:
-                  scurrency:
+                begin
-                    begin
+                  name:=procprefixes[do_read]+'enum';
-                      name := procprefixes[do_read]+'currency';
+                  readfunctype:=s32inttype;
-                      { iso pascal needs a different handler }
+                end;
-                      if (m_isolike_io in current_settings.modeswitches) and do_read then
+              orddef :
-                        name:=name+'_iso';
+                begin
-                      readfunctype:=s64currencytype;
+                  case Torddef(para.left.resultdef).ordtype of
-                      is_real:=true;
+                    s8bit,
-                    end;
+                    s16bit,
-                  pasbool1,
+                    s32bit,
-                  pasbool8,
+                    s64bit,
-                  pasbool16,
+                    u8bit,
-                  pasbool32,
+                    u16bit,
-                  pasbool64,
+                    u32bit,
-                  bool8bit,
+                    u64bit:
-                  bool16bit,
+                      begin
-                  bool32bit,
+                        get_read_write_int_func(para.left.resultdef,func_suffix,readfunctype);
-                  bool64bit:
+                        name := procprefixes[do_read]+func_suffix;
-                    if do_read then
+                        if (m_isolike_io in current_settings.modeswitches) and do_read then
+                          name:=name+'_iso';
+                      end;
+                    uchar :
+                      begin
+                        name := procprefixes[do_read]+'char';
+                        { iso pascal needs a different handler }
+                        if (m_isolike_io in current_settings.modeswitches) and do_read then
+                          name:=name+'_iso';
+                        readfunctype:=cansichartype;
+                      end;
+                    uwidechar :
+                      begin
+                        name := procprefixes[do_read]+'widechar';
+                        readfunctype:=cwidechartype;
+                      end;
+                    scurrency:
+                      begin
+                        name := procprefixes[do_read]+'currency';
+                        { iso pascal needs a different handler }
+                        if (m_isolike_io in current_settings.modeswitches) and do_read then
+                          name:=name+'_iso';
+                        readfunctype:=s64currencytype;
+                        is_real:=true;
+                      end;
+                    pasbool1,
+                    pasbool8,
+                    pasbool16,
+                    pasbool32,
+                    pasbool64,
+                    bool8bit,
+                    bool16bit,
+                    bool32bit,
+                    bool64bit:
+                      if do_read then
+                        begin
+                          CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
+                          error_para := true;
+                        end
+                      else
+                        begin
+                          name := procprefixes[do_read]+'boolean';
+                          readfunctype:=pasbool1type;
+                        end
+                    else
                       begin
                         CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                         error_para := true;
-                      end
+                      end;
-                    else
+                  end;
-                      begin
+                end;
-                        name := procprefixes[do_read]+'boolean';
+              variantdef :
-                        readfunctype:=pasbool1type;
+                name:=procprefixes[do_read]+'variant';
-                      end
+              arraydef :
+                begin
+                  if is_chararray(para.left.resultdef) then
+                    name := procprefixes[do_read]+'pchar_as_array'
                   else
                     begin
                       CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                       error_para := true;
-                    end;
+                    end
                 end;
-              end;
+              else
-            variantdef :
+                begin
-              name:=procprefixes[do_read]+'variant';
+                  CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
-            arraydef :
+                  error_para := true;
-              begin
+                end;
-                if is_chararray(para.left.resultdef) then
+            end;
-                  name := procprefixes[do_read]+'pchar_as_array'
-                else
-                  begin
-                    CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
-                    error_para := true;
-                  end
-              end;
-            { generic parameter }
-            undefineddef:
-              { don't try to generate any code for a writeln on a generic parameter }
-              error_para:=true;
-            else
-              begin
-                CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
-                error_para := true;
-              end;
-          end;
 
           { iso pascal needs a different handler }
           if (m_isolike_io in current_settings.modeswitches) and not(do_read) then
@@ -2919,9 +2917,11 @@ implementation
 
               in_sizeof_x:
                 begin
-                  { the constant evaluation of in_sizeof_x happens in pexpr where possible }
+                  { the constant evaluation of in_sizeof_x happens in pexpr where possible,
+                    though for generics it can reach here as well }
                   set_varstate(left,vs_read,[]);
                   if (left.resultdef.typ<>undefineddef) and
+                      assigned(current_procinfo) and
                       paramanager.push_high_param(vs_value,left.resultdef,current_procinfo.procdef.proccalloption) then
                    begin
                      { this should be an open array or array of const, both of
@@ -3401,7 +3401,7 @@ implementation
                       inserttypeconv(tcallparanode(tcallparanode(left).right).left,
                         tsetdef(left.resultdef).elementdef);
                     end
-                  else
+                  else if left.resultdef.typ<>undefineddef then
                     CGMessage(type_e_mismatch);
                 end;
               in_pack_x_y_z,

compiler/pexpr.pas

@@ -440,7 +440,7 @@ implementation
                   is_open_string(p1.resultdef)
                  )) or
                  { keep the function call if it is a type parameter to avoid arithmetic errors due to constant folding }
-                 (p1.resultdef.typ=undefineddef) then
+                 is_typeparam(p1.resultdef) then
                 begin
                   statement_syssym:=geninlinenode(in_sizeof_x,false,p1);
                   { no packed bit support for these things }
@@ -2959,11 +2959,11 @@ implementation
                wasgenericdummy:=false;
                if assigned(srsym) and
                    (sp_generic_dummy in srsym.symoptions) and
+                   (srsym.typ=typesym) and
                    (
                      (
                        (m_delphi in current_settings.modeswitches) and
                        not (token in [_LT, _LSHARPBRACKET]) and
-                       (srsym.typ=typesym) and
                        (ttypesym(srsym).typedef.typ=undefineddef)
                      )
                      or

compiler/pgenutil.pas

@@ -1259,6 +1259,7 @@ uses
         doconsume : boolean;
         constraintdata : tgenericconstraintdata;
         old_block_type : tblock_type;
+        fileinfo : tfileposinfo;
       begin
         result:=tfphashobjectlist.create(false);
         firstidx:=0;
@@ -1274,6 +1275,7 @@ uses
               result.add(orgpattern,generictype);
             end;
           consume(_ID);
+          fileinfo:=current_tokenpos;
           if try_to_consume(_COLON) then
             begin
               if not allowconstraints then
@@ -1281,6 +1283,7 @@ uses
                 Message(parser_e_illegal_expression{ parser_e_generic_constraints_not_allowed_here});
               { construct a name which can be used for a type specification }
               constraintdata:=tgenericconstraintdata.create;
+              constraintdata.fileinfo:=fileinfo;
               defname:='';
               str(current_module.deflist.count,defname);
               defname:='$gendef'+defname;
@@ -1395,6 +1398,7 @@ uses
                     genconstraintdata:=tgenericconstraintdata.create;
                     genconstraintdata.flags:=constraintdata.flags;
                     genconstraintdata.interfaces.assign(constraintdata.interfaces);
+                    genconstraintdata.fileinfo:=constraintdata.fileinfo;
                     include(defoptions,df_genconstraint);
                   end;
 

compiler/procdefutil.pas

@@ -65,6 +65,10 @@ implementation
       symtablestack:=nil;
       result:=cprocdef.create(max(normal_function_level,st.symtablelevel)+1,true);
       result.returndef:=resultdef;
+      { if the parent is a generic or a specialization, the new function is one
+        as well }
+      if st.symtabletype=localsymtable then
+        result.defoptions:=result.defoptions+(tstoreddef(st.defowner).defoptions*[df_generic,df_specialization]);
       symtablestack:=oldsymtablestack;
       st.insertdef(result);
       result.struct:=astruct;

compiler/symdef.pas

@@ -50,6 +50,8 @@ interface
          interfaces : tfpobjectlist;
          interfacesderef : tfplist;
          flags : tgenericconstraintflags;
+         { only required while parsing }
+         fileinfo : tfileposinfo;
          constructor create;
          destructor destroy;override;
          procedure ppuload(ppufile:tcompilerppufile);

tests/tbs/tb0668a.pp

@@ -0,0 +1,20 @@
+{ %NORUN }
+
+program tb0668a;
+
+{$mode objfpc}
+
+procedure FreeAndNil(var Obj);
+begin
+end;
+
+generic procedure FreeAndNil<T: class>(var Obj: T);
+begin
+end;
+
+var
+  t: TObject;
+begin
+  FreeAndNil(t);
+  specialize FreeAndNil<TObject>(t);
+end.

tests/tbs/tb0668b.pp

@@ -0,0 +1,20 @@
+{ %NORUN }
+
+program tb0668b;
+
+{$mode objfpc}
+
+generic procedure FreeAndNil<T: class>(var Obj: T);
+begin
+end;
+
+procedure FreeAndNil(var Obj);
+begin
+end;
+
+var
+  t: TObject;
+begin
+  FreeAndNil(t);
+  specialize FreeAndNil<TObject>(t);
+end.

tests/tbs/tb0677.pp

@@ -0,0 +1,40 @@
+{ %NORUN }
+
+program tb0677;
+
+{$mode objfpc}
+
+type
+  TEnum = (eOne, eTwo, eThree, eFour);
+  TSet = set of TEnum;
+
+  generic TTest<SetType, EnumType> = class
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+var
+  s1: TSet;
+  s2: SetType;
+  e1: TEnum;
+  e2: EnumType;
+begin
+  Include(s1, e1);
+  Exclude(s1, e1);
+
+  Include(s2, e1);
+  Exclude(s2, e1);
+
+  Include(s2, e2);
+  Exclude(s2, e2);
+
+  Include(s2, e1);
+  Exclude(s2, e2);
+end;
+
+type
+  TTestTypes = specialize TTest<TSet, TEnum>;
+
+begin
+
+end.

tests/webtbs/tw37107.pp

@@ -0,0 +1,19 @@
+program genTest;
+
+{$IFDEF FPC}{$mode Delphi}{$ENDIF}
+
+type
+  TTest<T: Record> = class(TObject)
+    procedure testit();
+  end;
+
+procedure TTest<T>.testit();
+begin
+  WriteLn('=== ', 1 div SizeOf(T));
+  if SizeOf(T) > 0 then
+    WriteLn('I''m reachable!')
+end;
+  
+begin
+  TTest<Char>.Create().TestIt();
+end.

tests/webtbs/tw37187.pp

@@ -0,0 +1,19 @@
+{ %NORUN }
+
+program tw37187;
+
+{$mode objfpc}
+
+type
+  generic TTest<T: class> = class
+    arr: array[0..SizeOf(T)] of Byte;
+  end;
+
+  generic TTest2<T: class> = class
+  public type
+    TTestT = specialize TTest<T>;
+  end;
+
+begin
+
+end.

tests/webtbs/tw37806.pp

@@ -0,0 +1,26 @@
+program tw37806;
+
+{$mode delphi}
+
+procedure TurnSetElem<TSet, TElem>(var aSet: TSet; aElem: TElem; aOn: Boolean);
+begin
+  if aOn then
+    Include(aSet, aElem)
+  else
+    Exclude(aSet, aElem);
+end;
+
+type
+  TElem = (One, Two, Three, Four, Five);
+  TSet = set of TElem;
+
+var
+  s: TSet = [];
+
+begin
+  TurnSetElem<TSet, TElem>(s, Two, True);
+  TurnSetElem<TSet, TElem>(s, Five, True);
+  if not((Two in s) and (Five in s)) then
+    Halt(1);
+    //WriteLn('does not work');
+end.