Browse Source

* 1.0.10 starting patch from Peter

florian 20 years ago
parent
commit
ef9b70f1f4
2 changed files with 40 additions and 39 deletions
  1. 5 2
      compiler/globals.pas
  2. 35 37
      compiler/ncnv.pas

+ 5 - 2
compiler/globals.pas

@@ -78,7 +78,7 @@ interface
 
        treelogfilename = 'tree.log';
 
-{$if (defined(CPUARM) and defined(FPUFPA))}
+{$if defined(CPUARM) and defined(FPUFPA)}
        MathQNaN : tdoublearray = (0,0,252,255,0,0,0,0);
        MathInf : tdoublearray = (0,0,240,127,0,0,0,0);
        MathNegInf : tdoublearray = (0,0,240,255,0,0,0,0);
@@ -2180,7 +2180,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.158  2005-01-06 09:20:36  karoly
+  Revision 1.159  2005-01-06 13:40:41  florian
+    * 1.0.10 starting patch from Peter
+
+  Revision 1.158  2005/01/06 09:20:36  karoly
     * made Shell() work correctly on MorphOS
 
   Revision 1.157  2005/01/04 17:40:33  karoly

+ 35 - 37
compiler/ncnv.pas

@@ -660,7 +660,7 @@ implementation
       var
         chartype : string[8];
       begin
-        if is_widechar(tarraydef(left.resulttype).elementtype.def) then
+        if is_widechar(tarraydef(left.resulttype.def).elementtype.def) then
           chartype:='widechar'
         else
           chartype:='char';
@@ -691,7 +691,7 @@ implementation
              result := nil;
              exit;
            end;
-        if is_widechar(tarraydef(resulttype).elementtype.def) then
+        if is_widechar(tarraydef(resulttype.def).elementtype.def) then
           chartype:='widechar'
         else
           chartype:='char';
@@ -1471,42 +1471,37 @@ implementation
                          (resulttype.def.deftype <> floatdef))  then
                        make_not_regable(left);
 
-                     { class to class or object to object, with checkobject support }
-                     if (resulttype.def.deftype=objectdef) and
-                        (left.resulttype.def.deftype=objectdef) then
+                     { class/interface to class/interface, with checkobject support }
+                     if is_class_or_interface(resulttype.def) and
+                        is_class_or_interface(left.resulttype.def) then
                        begin
+                         { check if the types are related }
+                         if not(nf_internal in flags) and
+                            (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
+                            (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
+                           begin
+                             { Give an error when typecasting class to interface, this is compatible
+                               with delphi }
+                             if is_interface(resulttype.def) and
+                                not is_interface(left.resulttype.def) then
+                               CGMessage2(type_e_classes_not_related,
+                                 FullTypeName(left.resulttype.def,resulttype.def),
+                                 FullTypeName(resulttype.def,left.resulttype.def))
+                             else
+                               CGMessage2(type_w_classes_not_related,
+                                 FullTypeName(left.resulttype.def,resulttype.def),
+                                 FullTypeName(resulttype.def,left.resulttype.def))
+                           end;
+
+                         { Add runtime check? }
                          if (cs_check_object in aktlocalswitches) then
-                          begin
-                            if is_class_or_interface(resulttype.def) then
-                             begin
-                               { we can translate the typeconvnode to 'as' when
-                                 typecasting to a class or interface }
-                               hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
-                               left:=nil;
-                               result:=hp;
-                               exit;
-                             end;
-                          end
-                         else
-                          begin
-                            { check if the types are related }
-                            if not(nf_internal in flags) and
-                               (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
-                               (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
-                              begin
-                                { Give an error when typecasting class to interface, this is compatible
-                                  with delphi }
-                                if is_interface(resulttype.def) and
-                                   not is_interface(left.resulttype.def) then
-                                  CGMessage2(type_e_classes_not_related,
-                                    FullTypeName(left.resulttype.def,resulttype.def),
-                                    FullTypeName(resulttype.def,left.resulttype.def))
-                                else
-                                  CGMessage2(type_w_classes_not_related,
-                                    FullTypeName(left.resulttype.def,resulttype.def),
-                                    FullTypeName(resulttype.def,left.resulttype.def))
-                              end;
-                          end;
+                           begin
+                             { we can translate the typeconvnode to 'as' when
+                               typecasting to a class or interface }
+                             hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
+                             left:=nil;
+                             result:=hp;
+                           end;
                        end
 
                       else
@@ -2551,7 +2546,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.171  2005-01-06 13:30:41  florian
+  Revision 1.172  2005-01-06 13:40:41  florian
+    * 1.0.10 starting patch from Peter
+
+  Revision 1.171  2005/01/06 13:30:41  florian
     * widechararray patch from Peter
 
   Revision 1.170  2005/01/03 17:55:57  florian