Browse Source

--- Merging r45365 into '.':
U compiler/systems/t_embed.pas
--- Recording mergeinfo for merge of r45365 into '.':
U .
--- Merging r45707 into '.':
U compiler/defcmp.pas
A tests/tbs/tb0675.pp
--- Recording mergeinfo for merge of r45707 into '.':
G .
--- Merging r46279 into '.':
U compiler/pexpr.pas
A tests/test/tarrconstr8.pp
--- Recording mergeinfo for merge of r46279 into '.':
G .
--- Merging r47110 into '.':
U compiler/symdef.pas
A tests/tbs/tb0679.pp
A tests/tbs/tb0680.pp
--- Recording mergeinfo for merge of r47110 into '.':
G .

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

svenbarth 4 years ago
parent
commit
036c9f7ff2

+ 4 - 0
.gitattributes

@@ -12934,9 +12934,12 @@ 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/tb0670.pp svneol=native#text/pascal
+tests/tbs/tb0675.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/tb0679.pp svneol=native#text/pascal
+tests/tbs/tb0680.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
@@ -13957,6 +13960,7 @@ tests/test/tarrconstr4.pp svneol=native#text/pascal
 tests/test/tarrconstr5.pp svneol=native#text/pascal
 tests/test/tarrconstr6.pp svneol=native#text/pascal
 tests/test/tarrconstr7.pp svneol=native#text/pascal
+tests/test/tarrconstr8.pp svneol=native#text/pascal
 tests/test/tasm1.pp svneol=native#text/plain
 tests/test/tasm10.pp svneol=native#text/plain
 tests/test/tasm10a.pp svneol=native#text/plain

+ 14 - 2
compiler/defcmp.pas

@@ -822,7 +822,14 @@ implementation
                          { the orddef < currency (then it will get convert l3, }
                          { and conversion to float is favoured)                }
                          doconv:=tc_int_2_real;
-                         eq:=te_convert_l2;
+                         if is_extended(def_to) then
+                           eq:=te_convert_l2
+                         else if is_double(def_to) then
+                           eq:=te_convert_l3
+                         else if is_single(def_to) then
+                           eq:=te_convert_l4
+                         else
+                           eq:=te_convert_l2;
                        end;
                    end;
                  floatdef :
@@ -843,7 +850,12 @@ implementation
                              { do we lose precision? }
                              if (def_to.size<def_from.size) or
                                (is_currency(def_from) and (tfloatdef(def_to).floattype in [s32real,s64real])) then
-                               eq:=te_convert_l2
+                               begin
+                                 if is_currency(def_from) and (tfloatdef(def_to).floattype=s32real) then
+                                   eq:=te_convert_l3
+                                 else
+                                   eq:=te_convert_l2
+                               end
                              else
                                eq:=te_convert_l1;
                            end;

+ 16 - 6
compiler/pexpr.pas

@@ -2449,16 +2449,26 @@ implementation
                            begin
                              if not try_type_helper(p1,nil) then
                                begin
-                                 if pattern='CREATE' then
+                                 if p1.nodetype=typen then
                                    begin
-                                     consume(_ID);
-                                     p2:=parse_array_constructor(tarraydef(p1.resultdef));
-                                     p1.destroy;
-                                     p1:=p2;
+                                     if pattern='CREATE' then
+                                       begin
+                                         consume(_ID);
+                                         p2:=parse_array_constructor(tarraydef(p1.resultdef));
+                                         p1.destroy;
+                                         p1:=p2;
+                                       end
+                                     else
+                                       begin
+                                         Message2(scan_f_syn_expected,'CREATE',pattern);
+                                         p1.destroy;
+                                         p1:=cerrornode.create;
+                                         consume(_ID);
+                                       end;
                                    end
                                  else
                                    begin
-                                     Message2(scan_f_syn_expected,'CREATE',pattern);
+                                     Message(parser_e_invalid_qualifier);
                                      p1.destroy;
                                      p1:=cerrornode.create;
                                      consume(_ID);

+ 8 - 1
compiler/symdef.pas

@@ -6261,10 +6261,17 @@ implementation
 
 
     function tprocdef.defaultmangledname: TSymStr;
+      var
+        n : TSymStr;
       begin
+        n:=procsym.name;
+        { make sure that the mangled names of these overloadable methods types is
+          unique even if it's made lowercase (e.g. for section names) }
+        if proctypeoption in [potype_operator,potype_class_constructor,potype_class_destructor] then
+          n:='$'+n;
         { we need to use the symtable where the procsym is inserted,
           because that is visible to the world }
-        defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
+        defaultmangledname:=make_mangledname('',procsym.owner,n);
         defaultmangledname:=defaultmangledname+mangledprocparanames(Length(defaultmangledname))
       end;
 

+ 4 - 0
compiler/systems/t_embed.pas

@@ -1310,6 +1310,10 @@ begin
         success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+
           ChangeFileExt(current_module.exefilename,'.elf')+' '+
           ChangeFileExt(current_module.exefilename,'.bin'),true,false);
+{$ifdef ARM}
+      if success and (current_settings.controllertype = ct_raspi2) then
+        success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+ FixedExeFileName + ' kernel7.img',true,false);
+{$endif ARM}
     end;
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }

+ 45 - 0
tests/tbs/tb0675.pp

@@ -0,0 +1,45 @@
+program tb0675;
+
+{$mode objfpc}
+
+function Test(a: Single): LongInt;
+begin
+  Result := 1;
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function Test(a: Double): LongInt;
+begin
+  Result := 2;
+end;
+{$endif}
+
+function Test2(a: Single): LongInt;
+begin
+  Result := 1;
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function Test2(a: Double): LongInt;
+begin
+  Result := 2;
+end;
+{$endif}
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function Test2(a: Extended): LongInt;
+begin
+  Result := 3;
+end;
+{$endif}
+
+var
+  a: Currency;
+begin
+  if Test(a) <> 2 then
+    Halt(1);
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+  if Test2(a) <> 3 then
+    Halt(2);
+{$endif}
+end.

+ 28 - 0
tests/tbs/tb0679.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+
+program tb0679;
+
+{$mode objfpc}
+
+type
+  TA = class
+  public
+    class destructor Destroy; 
+    destructor Destroy; override;
+  end;
+  
+class destructor TA.Destroy; 
+begin
+end;
+    
+destructor TA.Destroy;
+begin
+  inherited;
+end;
+ 
+var
+  A: TA;
+begin
+  A := TA.Create;
+  A.Free;
+end.

+ 26 - 0
tests/tbs/tb0680.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+program tb0680;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+    class operator + (aLeft, aRight: TTest): TTest;
+    function Plus(aLeft, aRight: TTest): TTest;
+  end;
+
+class operator TTest.+(aLeft, aRight: TTest): TTest;
+begin
+
+end;
+
+function TTest.Plus(aLeft, aRight: TTest): TTest;
+begin
+
+end;
+
+begin
+
+end.

+ 13 - 0
tests/test/tarrconstr8.pp

@@ -0,0 +1,13 @@
+{ %FAIL }
+
+program tarrconstr8;
+
+type
+  TLongIntArray = array of LongInt;
+
+var
+  arr: TLongIntArray;
+begin
+  // Create *must* be used on a type
+  arr := arr.Create(1, 2);
+end.