Browse Source

Fix for Mantis #23547. Basically we now fail with nicer error messages.

pgenutil.pas:
  generate_specialization:
    + instead of giving an internal error if "symname" is empty and "tt" is "nil" we now do an error recovery by parsing the specialization parameters and returning an errordef (this happens if the "generic" type before the "<" is not found)
    * handle "<>" specially by giving an approbiate error message (both when doing a recovery/parsing a generic and during normal specialization)
  parse_generic_parameters:
    * set the "block_type" to "bt_type" to be on the safe side
    * don't continue with inspecting the def (especially hard typecasting) if the found def is not an "objectdef"

Added tests.

git-svn-id: trunk@23344 -
svenbarth 12 years ago
parent
commit
27f5e4f582
5 changed files with 87 additions and 31 deletions
  1. 3 0
      .gitattributes
  2. 56 31
      compiler/pgenutil.pas
  3. 8 0
      tests/webtbf/tw23547a.pp
  4. 10 0
      tests/webtbf/tw23547b.pp
  5. 10 0
      tests/webtbf/tw23547c.pp

+ 3 - 0
.gitattributes

@@ -12027,6 +12027,9 @@ tests/webtbf/tw2281.pp svneol=native#text/plain
 tests/webtbf/tw2285.pp svneol=native#text/plain
 tests/webtbf/tw2285.pp svneol=native#text/plain
 tests/webtbf/tw22941.pp svneol=native#text/plain
 tests/webtbf/tw22941.pp svneol=native#text/plain
 tests/webtbf/tw23110.pp svneol=native#text/plain
 tests/webtbf/tw23110.pp svneol=native#text/plain
+tests/webtbf/tw23547a.pp svneol=native#text/pascal
+tests/webtbf/tw23547b.pp svneol=native#text/pascal
+tests/webtbf/tw23547c.pp svneol=native#text/pascal
 tests/webtbf/tw2357.pp svneol=native#text/plain
 tests/webtbf/tw2357.pp svneol=native#text/plain
 tests/webtbf/tw2359.pp svneol=native#text/plain
 tests/webtbf/tw2359.pp svneol=native#text/plain
 tests/webtbf/tw2362.pp svneol=native#text/plain
 tests/webtbf/tw2362.pp svneol=native#text/plain

+ 56 - 31
compiler/pgenutil.pas

@@ -361,6 +361,7 @@ uses
         st  : TSymtable;
         st  : TSymtable;
         srsym : tsym;
         srsym : tsym;
         pt2 : tnode;
         pt2 : tnode;
+        errorrecovery,
         found,
         found,
         first,
         first,
         err : boolean;
         err : boolean;
@@ -392,34 +393,43 @@ uses
         tt:=nil;
         tt:=nil;
 
 
         { either symname must be given or genericdef needs to be valid }
         { either symname must be given or genericdef needs to be valid }
+        errorrecovery:=false;
         if (symname='') and
         if (symname='') and
             (not assigned(genericdef) or
             (not assigned(genericdef) or
             not assigned(genericdef.typesym) or
             not assigned(genericdef.typesym) or
             (genericdef.typesym.typ<>typesym)) then
             (genericdef.typesym.typ<>typesym)) then
-           internalerror(2011042701);
+          begin
+            errorrecovery:=true;
+            tt:=generrordef;
+          end;
 
 
         { Only parse the parameters for recovery or
         { Only parse the parameters for recovery or
           for recording in genericbuf }
           for recording in genericbuf }
-        if parse_generic then
+        if parse_generic or errorrecovery then
           begin
           begin
             first:=assigned(parsedtype);
             first:=assigned(parsedtype);
             if not first and not try_to_consume(_LT) then
             if not first and not try_to_consume(_LT) then
               consume(_LSHARPBRACKET);
               consume(_LSHARPBRACKET);
             gencount:=0;
             gencount:=0;
-            repeat
-              if not first then
-                begin
-                  pt2:=factor(false,true);
-                  pt2.free;
-                end;
-              first:=false;
-              inc(gencount);
-            until not try_to_consume(_COMMA);
+            { handle "<>" }
+            if (token=_RSHARPBRACKET) or (token=_GT) then
+              Message(type_e_type_id_expected)
+            else
+              repeat
+                if not first then
+                  begin
+                    pt2:=factor(false,true);
+                    pt2.free;
+                  end;
+                first:=false;
+                inc(gencount);
+              until not try_to_consume(_COMMA);
             if not try_to_consume(_GT) then
             if not try_to_consume(_GT) then
               consume(_RSHARPBRACKET);
               consume(_RSHARPBRACKET);
             { we need to return a def that can later pass some checks like
             { we need to return a def that can later pass some checks like
               whether it's an interface or not }
               whether it's an interface or not }
-            if not assigned(tt) or (tt.typ=undefineddef) then
+            if not errorrecovery and
+                (not assigned(tt) or (tt.typ=undefineddef)) then
               begin
               begin
                 if (symname='') and (df_generic in genericdef.defoptions) then
                 if (symname='') and (df_generic in genericdef.defoptions) then
                   { this happens in non-Delphi modes }
                   { this happens in non-Delphi modes }
@@ -477,6 +487,16 @@ uses
         if not assigned(parsedtype) and not try_to_consume(_LT) then
         if not assigned(parsedtype) and not try_to_consume(_LT) then
           consume(_LSHARPBRACKET);
           consume(_LSHARPBRACKET);
 
 
+        { handle "<>" }
+        if (token=_GT) or (token=_RSHARPBRACKET) then
+          begin
+            Message(type_e_type_id_expected);
+            if not try_to_consume(_GT) then
+              try_to_consume(_RSHARPBRACKET);
+            tt:=generrordef;
+            exit;
+          end;
+
         genericdeflist:=TFPObjectList.Create(false);
         genericdeflist:=TFPObjectList.Create(false);
         poslist:=tfplist.create;
         poslist:=tfplist.create;
 
 
@@ -852,9 +872,12 @@ uses
         allowconstructor,
         allowconstructor,
         doconsume : boolean;
         doconsume : boolean;
         constraintdata : tgenericconstraintdata;
         constraintdata : tgenericconstraintdata;
+        old_block_type : tblock_type;
       begin
       begin
         result:=TFPObjectList.Create(false);
         result:=TFPObjectList.Create(false);
         firstidx:=0;
         firstidx:=0;
+        old_block_type:=block_type;
+        block_type:=bt_type;
         repeat
         repeat
           if token=_ID then
           if token=_ID then
             begin
             begin
@@ -922,27 +945,28 @@ uses
                       { only types that are inheritable are allowed }
                       { only types that are inheritable are allowed }
                       if (def.typ<>objectdef) or
                       if (def.typ<>objectdef) or
                           not (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_javaclass]) then
                           not (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_javaclass]) then
-                        Message(type_e_class_or_interface_type_expected);
-                      case tobjectdef(def).objecttype of
-                        odt_class,
-                        odt_javaclass:
-                          begin
-                            if gcf_class in constraintdata.flags then
-                              { "class" + concrete class is not allowed }
-                              Message(parser_e_illegal_expression)
-                            else
-                              { do we already have a concrete class? }
-                              if constraintdata.basedef<>generrordef then
+                        Message1(type_e_class_or_interface_type_expected,def.typename)
+                      else
+                        case tobjectdef(def).objecttype of
+                          odt_class,
+                          odt_javaclass:
+                            begin
+                              if gcf_class in constraintdata.flags then
+                                { "class" + concrete class is not allowed }
                                 Message(parser_e_illegal_expression)
                                 Message(parser_e_illegal_expression)
                               else
                               else
-                                constraintdata.basedef:=def;
-                          end;
-                        odt_interfacecom,
-                        odt_interfacecorba,
-                        odt_interfacejava,
-                        odt_dispinterface:
-                          constraintdata.interfaces.add(def);
-                      end;
+                                { do we already have a concrete class? }
+                                if constraintdata.basedef<>generrordef then
+                                  Message(parser_e_illegal_expression)
+                                else
+                                  constraintdata.basedef:=def;
+                            end;
+                          odt_interfacecom,
+                          odt_interfacecorba,
+                          odt_interfacejava,
+                          odt_dispinterface:
+                            constraintdata.interfaces.add(def);
+                        end;
                     end;
                     end;
                 end;
                 end;
                 if doconsume then
                 if doconsume then
@@ -986,6 +1010,7 @@ uses
               constraintdata.free;
               constraintdata.free;
             end;
             end;
         until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
         until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
+        block_type:=old_block_type;
       end;
       end;
 
 
 
 

+ 8 - 0
tests/webtbf/tw23547a.pp

@@ -0,0 +1,8 @@
+{ %FAIL }
+
+{$MODE DELPHI}
+
+type Wrapper<T: Wrapper<>> = record end;
+
+begin
+end.

+ 10 - 0
tests/webtbf/tw23547b.pp

@@ -0,0 +1,10 @@
+{ %FAIL }
+
+{$MODE DELPHI}
+
+type
+  SmallWrapper<T> = class end;
+  Wrapper<T: SmallWrapper<>> = record end;
+
+begin
+end.

+ 10 - 0
tests/webtbf/tw23547c.pp

@@ -0,0 +1,10 @@
+{ %FAIL }
+
+{$MODE DELPHI}
+
+type
+  SmallWrapper<T> = class end;
+  Wrapper<T: SmallWrapper<Byte, Byte>> = record end;
+
+begin
+end.