--- Merging r39785 into '.':

U    packages/fcl-stl/src/gset.pp
--- Recording mergeinfo for merge of r39785 into '.':
 U   .
--- Merging r39786 into '.':
A    tests/tbs/tb0651.pp
U    compiler/symdef.pas
--- Recording mergeinfo for merge of r39786 into '.':
 G   .
--- Merging r39787 into '.':
U    compiler/pexpr.pas
A    tests/webtbs/uw34287a.pp
A    tests/webtbs/tw34287.pp
A    tests/webtbs/uw34287b.pp
--- Recording mergeinfo for merge of r39787 into '.':
 G   .
--- Merging r39788 into '.':
U    compiler/nbas.pas
--- Recording mergeinfo for merge of r39788 into '.':
 G   .
--- Merging r39812 into '.':
G    compiler/pexpr.pas
--- Recording mergeinfo for merge of r39812 into '.':
 G   .

# revisions: 39785,39786,39787,39788,39812

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

.gitattributes

@@ -11597,6 +11597,7 @@ tests/tbs/tb0646b.pp svneol=native#text/pascal
 tests/tbs/tb0648.pp svneol=native#text/pascal
 tests/tbs/tb0649.pp -text svneol=native#text/pascal
 tests/tbs/tb0650.pp svneol=native#text/pascal
+tests/tbs/tb0651.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -16248,6 +16249,7 @@ tests/webtbs/tw34124.pp svneol=native#text/pascal
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain
 tests/webtbs/tw34239.pp svneol=native#text/pascal
+tests/webtbs/tw34287.pp svneol=native#text/pascal
 tests/webtbs/tw3429.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3435.pp svneol=native#text/plain
@@ -16858,6 +16860,8 @@ tests/webtbs/uw3340.pp svneol=native#text/plain
 tests/webtbs/uw3353.pp svneol=native#text/plain
 tests/webtbs/uw3356.pp svneol=native#text/plain
 tests/webtbs/uw33839.pp -text svneol=native#text/pascal
+tests/webtbs/uw34287a.pp svneol=native#text/pascal
+tests/webtbs/uw34287b.pp svneol=native#text/pascal
 tests/webtbs/uw3429.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain

compiler/nbas.pas

@@ -51,7 +51,9 @@ interface
        tspecializenode = class(tunarynode)
           sym:tsym;
           getaddr:boolean;
+          inheriteddef:tdef;
           constructor create(l:tnode;g:boolean;s:tsym);virtual;
+          constructor create_inherited(l:tnode;g:boolean;s:tsym;i:tdef);virtual;
           function pass_1:tnode;override;
           function pass_typecheck:tnode;override;
        end;
@@ -430,6 +432,12 @@ implementation
          getaddr:=g;
       end;
 
+    constructor tspecializenode.create_inherited(l:tnode;g:boolean;s:tsym;i:tdef);
+      begin
+        create(l,g,s);
+        inheriteddef:=i;
+      end;
+
 
     function tspecializenode.pass_typecheck:tnode;
       begin

compiler/pexpr.pas

@@ -1005,7 +1005,7 @@ implementation
           end;
 
          { only need to get the address of the procedure? Check token because
-           in the case of opening parenthesis is possible to get pointer to 
+           in the case of opening parenthesis is possible to get pointer to
            function result (lack of checking for token was the reason of
            tw10933.pp test failure) }
          if getaddr and (token<>_LKLAMMER) then
@@ -3362,6 +3362,9 @@ implementation
          filepos    : tfileposinfo;
          callflags  : tcallnodeflags;
          idstr      : tidstring;
+         spezcontext : tspecializationcontext;
+         isspecialize,
+         mightbegeneric,
          useself,
          dopostfix,
          again,
@@ -3376,6 +3379,7 @@ implementation
         filepos:=current_tokenpos;
         again:=false;
         pd:=nil;
+        isspecialize:=false;
         if token=_ID then
          begin
            again:=true;
@@ -3483,6 +3487,7 @@ implementation
                       hclassdef:=java_fpcbaserecordtype
                     else
                       internalerror(2012012401);
+                    spezcontext:=nil;
                     { if inherited; only then we need the method with
                       the same name }
                     if token <> _ID then
@@ -3508,6 +3513,18 @@ implementation
                      end
                     else
                      begin
+                       if not (m_delphi in current_settings.modeswitches) and
+                           (block_type in inline_specialization_block_types) and
+                           (token=_ID) and
+                           (idtoken=_SPECIALIZE) then
+                         begin
+                           consume(_ID);
+                           if token<>_ID then
+                             message(parser_e_methode_id_expected);
+                           isspecialize:=true;
+                         end
+                       else
+                         isspecialize:=false;
                        hs:=pattern;
                        hsorg:=orgpattern;
                        consume(_ID);
@@ -3517,53 +3534,71 @@ implementation
                          searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
                        else
                          searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
+                       if isspecialize and assigned(srsym) then
+                         begin
+                           if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
+                             srsym:=nil;
+                         end;
                      end;
                     if assigned(srsym) then
                      begin
-                       check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                       mightbegeneric:=(m_delphi in current_settings.modeswitches) and
+                                         (token in [_LT,_LSHARPBRACKET]) and
+                                         (sp_generic_dummy in srsym.symoptions);
                        { load the procdef from the inherited class and
                          not from self }
                        case srsym.typ of
+                         typesym,
                          procsym:
                            begin
-                             useself:=false;
+                             { typesym is only a valid choice if we're dealing
-                             if is_objectpascal_helper(current_structdef) then
+                               with a potential generic }
+                             if (srsym.typ=typesym) and not mightbegeneric then
                                begin
-                                 { for a helper load the procdef either from the
+                                 Message(parser_e_methode_id_expected);
-                                   extended type, from the parent helper or from
+                                 p1:=cerrornode.create;
-                                   the extended type of the parent helper
+                               end
-                                   depending on the def the found symbol belongs
+                             else
-                                   to }
+                               begin
-                                 if (srsym.Owner.defowner.typ=objectdef) and
+                                 useself:=false;
-                                     is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
+                                 if is_objectpascal_helper(current_structdef) then
-                                   if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
+                                   begin
-                                       assigned(tobjectdef(current_structdef).childof) then
+                                     { for a helper load the procdef either from the
-                                     hdef:=tobjectdef(current_structdef).childof
+                                       extended type, from the parent helper or from
-                                   else
+                                       the extended type of the parent helper
-                                     begin
+                                       depending on the def the found symbol belongs
-                                       hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
+                                       to }
-                                       useself:=true;
+                                     if (srsym.Owner.defowner.typ=objectdef) and
-                                     end
+                                         is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
+                                       if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
+                                           assigned(tobjectdef(current_structdef).childof) then
+                                         hdef:=tobjectdef(current_structdef).childof
+                                       else
+                                         begin
+                                           hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
+                                           useself:=true;
+                                         end
+                                     else
+                                       begin
+                                         hdef:=tdef(srsym.Owner.defowner);
+                                         useself:=true;
+                                       end;
+                                   end
+                                 else
+                                   hdef:=hclassdef;
+                                 if (po_classmethod in current_procinfo.procdef.procoptions) or
+                                    (po_staticmethod in current_procinfo.procdef.procoptions) then
+                                   hdef:=cclassrefdef.create(hdef);
+                                 if useself then
+                                   begin
+                                     p1:=ctypeconvnode.create_internal(load_self_node,hdef);
+                                   end
                                  else
                                    begin
-                                     hdef:=tdef(srsym.Owner.defowner);
+                                     p1:=ctypenode.create(hdef);
-                                     useself:=true;
+                                     { we need to allow helpers here }
+                                     ttypenode(p1).helperallowed:=true;
                                    end;
-                               end
-                             else
-                               hdef:=hclassdef;
-                             if (po_classmethod in current_procinfo.procdef.procoptions) or
-                                (po_staticmethod in current_procinfo.procdef.procoptions) then
-                               hdef:=cclassrefdef.create(hdef);
-                             if useself then
-                               begin
-                                 p1:=ctypeconvnode.create_internal(load_self_node,hdef);
-                               end
-                             else
-                               begin
-                                 p1:=ctypenode.create(hdef);
-                                 { we need to allow helpers here }
-                                 ttypenode(p1).helperallowed:=true;
                                end;
                            end;
                          propertysym:
@@ -3574,11 +3609,22 @@ implementation
                              p1:=cerrornode.create;
                            end;
                        end;
-                       callflags:=[cnf_inherited];
+                       if mightbegeneric then
-                       include(current_procinfo.flags,pi_has_inherited);
+                         begin
-                       if anon_inherited then
+                           p1:=cspecializenode.create_inherited(p1,getaddr,srsym,hclassdef);
-                         include(callflags,cnf_anon_inherited);
+                         end
-                       do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,nil);
+                       else
+                         begin
+                           if not isspecialize then
+                             check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                           callflags:=[cnf_inherited];
+                           include(current_procinfo.flags,pi_has_inherited);
+                           if anon_inherited then
+                             include(callflags,cnf_anon_inherited);
+                           do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,spezcontext);
+                         end;
+                       if p1.nodetype=errorn then
+                         spezcontext.free;
                      end
                     else
                      begin
@@ -3622,7 +3668,8 @@ implementation
                      again:=false;
                      p1:=cerrornode.create;
                    end;
-                 postfixoperators(p1,again,getaddr);
+                 if p1.nodetype<>specializen then
+                   postfixoperators(p1,again,getaddr);
                end;
 
              _INTCONST :
@@ -4045,18 +4092,22 @@ implementation
           getaddr : boolean;
           pload : tnode;
           spezcontext : tspecializationcontext;
-          structdef : tabstractrecorddef;
+          structdef,
+          inheriteddef : tabstractrecorddef;
+          callflags : tcallnodeflags;
         begin
           if n.nodetype=specializen then
             begin
               getaddr:=tspecializenode(n).getaddr;
               pload:=tspecializenode(n).left;
+              inheriteddef:=tabstractrecorddef(tspecializenode(n).inheriteddef);
               tspecializenode(n).left:=nil;
             end
           else
             begin
               getaddr:=false;
               pload:=nil;
+              inheriteddef:=nil;
             end;
 
           if assigned(parseddef) and assigned(gensym) and assigned(p2) then
@@ -4104,21 +4155,31 @@ implementation
             begin
               result:=pload;
               typecheckpass(result);
-              structdef:=nil;
+              structdef:=inheriteddef;
-              case result.resultdef.typ of
+              if not assigned(structdef) then
-                objectdef,
+                case result.resultdef.typ of
-                recorddef:
+                  objectdef,
-                  begin
+                  recorddef:
-                    structdef:=tabstractrecorddef(result.resultdef);
+                    begin
-                  end;
+                      structdef:=tabstractrecorddef(result.resultdef);
-                classrefdef:
+                    end;
-                  begin
+                  classrefdef:
-                    structdef:=tabstractrecorddef(tclassrefdef(result.resultdef).pointeddef);
+                    begin
-                  end;
+                      structdef:=tabstractrecorddef(tclassrefdef(result.resultdef).pointeddef);
-                else
+                    end;
-                  internalerror(2015092703);
+                  else
-              end;
+                    internalerror(2015092703);
-              do_member_read(structdef,getaddr,gensym,result,again,[],spezcontext);
+                end;
+              if not (structdef.typ in [recorddef,objectdef]) then
+                internalerror(2018092101);
+              if assigned(inheriteddef) then
+                begin
+                  callflags:=[cnf_inherited];
+                  include(current_procinfo.flags,pi_has_inherited);
+                end
+              else
+                callflags:=[];
+              do_member_read(structdef,getaddr,gensym,result,again,callflags,spezcontext);
               spezcontext:=nil;
             end
           else

compiler/symdef.pas

@@ -2913,8 +2913,12 @@ implementation
              (high > (system.high(int64) div 2)))) then
 {$endif cpu64bitalu}
           result := 64
-        else if (low >= 0) and
+        else if (
-           (high <= 1) then
+            (low >= 0) and
+            (high <= 1)
+           ) or (
+             ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]
+           ) then
           result := 1
         else
           begin

packages/fcl-stl/src/gset.pp

@@ -53,7 +53,7 @@ type
     function RotateLeft(nod:PNode):PNode;inline;
     procedure FlipColors(nod:PNode);inline;
     function IsRed(nod:PNode):boolean;inline;
-    function Insert(value:T; nod:PNode; var position:PNode):PNode;
+    function Insert(value:T; nod:PNode; out position:PNode):PNode;
     function FixUp(nod:PNode):PNode;inline;
     function MoveRedLeft(nod:PNode):PNode;inline;
     function MoveRedRight(nod:PNode):PNode;inline;
@@ -413,7 +413,7 @@ begin
   InsertAndGetIterator := ret;
 end;
 
-function TSet.Insert(value:T; nod:PNode; var position:PNode):PNode;
+function TSet.Insert(value:T; nod:PNode; out position:PNode):PNode;
 begin
   if(nod=nil) then begin
     nod:=CreateNode(value);

tests/tbs/tb0651.pp

@@ -0,0 +1,55 @@
+program tb0651;
+
+{$mode objfpc}{$H+}
+
+type
+  TBooleanArray = array[0..7] of Boolean;
+
+  TBooleanByte = bitpacked array[0..7] of Boolean;
+  TBoolean16Byte = bitpacked array[0..7] of Boolean16;
+  TBoolean32Byte = bitpacked array[0..7] of Boolean32;
+  TBoolean64Byte = bitpacked array[0..7] of Boolean64;
+  TByteBoolByte = bitpacked array[0..7] of ByteBool;
+  TWordBoolByte = bitpacked array[0..7] of WordBool;
+  TLongBoolByte = bitpacked array[0..7] of LongBool;
+  TQWordBoolByte = bitpacked array[0..7] of QWordBool;
+
+generic procedure CheckValue<T>(aArr: T; const aExpected: TBooleanArray; aCode: LongInt);
+var
+  i: LongInt;
+begin
+  if SizeOf(T) <> 1 then
+    Halt(aCode * 10 + 1);
+  if BitSizeOf(T) <> 8 then
+    Halt(aCode * 10 + 2);
+  for i := 0 to High(aArr) do
+    if aArr[i] <> aExpected[i] then
+      Halt(aCode * 10 + 3 + i);
+end;
+
+var
+  exp: TBooleanArray = (True, False, True, False, False, True, False, True);
+  b: Byte = $A5;
+  pb8: TBooleanByte absolute b;
+  pb16: TBoolean16Byte absolute b;
+  pb32: TBoolean32Byte absolute b;
+  pb64: TBoolean64Byte absolute b;
+  bb8: TByteBoolByte absolute b;
+  bb16: TWordBoolByte absolute b;
+  bb32: TLongBoolByte absolute b;
+  bb64: TQWordBoolByte absolute b;
+begin
+  specialize CheckValue<TBooleanByte>(pb8, exp, 0);
+  specialize CheckValue<TBoolean16Byte>(pb16, exp, 1);
+  specialize CheckValue<TBoolean32Byte>(pb32, exp, 2);
+{$ifdef CPU64}
+  specialize CheckValue<TBoolean64Byte>(pb64, exp, 3);
+{$endif}
+  specialize CheckValue<TByteBoolByte>(bb8, exp, 4);
+  specialize CheckValue<TWordBoolByte>(bb16, exp, 5);
+  specialize CheckValue<TLongBoolByte>(bb32, exp, 6);
+{$ifdef CPU64}
+  specialize CheckValue<TQWordBoolByte>(bb64, exp, 7);
+{$endif}
+  Writeln('ok');
+end.

tests/webtbs/tw34287.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program tw34287;
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+uses
+  Classes,
+  uw34287a,
+  uw34287b;
+
+var
+  fooa: uw34287a.TFoo;
+  foob: uw34287b.TFoo;
+begin
+  fooa := uw34287a.TFoo.Create(nil);
+  fooa.Bar('');
+  foob := uw34287b.TFoo.Create(nil);
+  foob.Bar('');
+end.

tests/webtbs/uw34287a.pp

@@ -0,0 +1,37 @@
+unit uw34287a;
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes;
+
+type
+  TBase = class(TComponent)
+  public
+    function Bar<T: TComponent>(const P1: string; out P2: T): Boolean;
+  end;
+
+  TFoo = class(TBase)
+  public
+    function Bar(const P1: string): Boolean;
+  end;
+
+implementation
+
+function TBase.Bar<T>(const P1: string; out P2: T): Boolean;
+begin
+  Result := False;
+end;
+
+function TFoo.Bar(const P1: string): Boolean;
+var
+  C: TComponent;
+begin
+  Result := inherited Bar<TComponent>(P1, C);
+end;
+
+end.

tests/webtbs/uw34287b.pp

@@ -0,0 +1,37 @@
+unit uw34287b;
+
+{$IFDEF FPC}
+ {$MODE OBJFPC}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes;
+
+type
+  TBase = class(TComponent)
+  public
+    generic function Bar<T: TComponent>(const P1: string; out P2: T): Boolean;
+  end;
+
+  TFoo = class(TBase)
+  public
+    function Bar(const P1: string): Boolean;
+  end;
+
+implementation
+
+generic function TBase.Bar<T>(const P1: string; out P2: T): Boolean;
+begin
+  Result := False;
+end;
+
+function TFoo.Bar(const P1: string): Boolean;
+var
+  C: TComponent;
+begin
+  Result := inherited specialize Bar<TComponent>(P1, C);
+end;
+
+end.