Browse Source

* fixed error msg with type l=<var>
* block_type bt_const is now set in read_const_dec

peter 27 years ago
parent
commit
b56098e7e3
1 changed files with 47 additions and 39 deletions
  1. 47 39
      compiler/pdecl.pas

+ 47 - 39
compiler/pdecl.pas

@@ -81,15 +81,16 @@ unit pdecl;
          def : pdef;
          def : pdef;
          sym : psym;
          sym : psym;
          storetokenpos,filepos : tfileposinfo;
          storetokenpos,filepos : tfileposinfo;
+         old_block_type : tblock_type;
          ps : pconstset;
          ps : pconstset;
          pd : pbestreal;
          pd : pbestreal;
 {$ifdef USEANSISTRING}
 {$ifdef USEANSISTRING}
-
          sp : pstring;
          sp : pstring;
 {$endif USEANSISTRING}
 {$endif USEANSISTRING}
-
       begin
       begin
          consume(_CONST);
          consume(_CONST);
+         old_block_type:=block_type;
+         block_type:=bt_const;
          repeat
          repeat
            name:=pattern;
            name:=pattern;
            filepos:=tokenpos;
            filepos:=tokenpos;
@@ -146,15 +147,15 @@ unit pdecl;
                 end;
                 end;
               COLON:
               COLON:
                 begin
                 begin
+                   consume(COLON);
                    { this was missed, so const s : ^string = nil gives an
                    { this was missed, so const s : ^string = nil gives an
                      error (FK)
                      error (FK)
                    }
                    }
                    block_type:=bt_type;
                    block_type:=bt_type;
-                   consume(COLON);
                    ignore_equal:=true;
                    ignore_equal:=true;
                    def:=read_type('');
                    def:=read_type('');
-                   block_type:=bt_general;
                    ignore_equal:=false;
                    ignore_equal:=false;
+                   block_type:=bt_const;
                    storetokenpos:=tokenpos;
                    storetokenpos:=tokenpos;
                    tokenpos:=filepos;
                    tokenpos:=filepos;
                    sym:=new(ptypedconstsym,init(name,def));
                    sym:=new(ptypedconstsym,init(name,def));
@@ -167,6 +168,7 @@ unit pdecl;
               else consume(EQUAL);
               else consume(EQUAL);
            end;
            end;
          until token<>ID;
          until token<>ID;
+         block_type:=old_block_type;
       end;
       end;
 
 
     procedure label_dec;
     procedure label_dec;
@@ -1582,46 +1584,48 @@ unit pdecl;
              end;
              end;
            { we can't accept a equal in type }
            { we can't accept a equal in type }
            pt1:=comp_expr(not(ignore_equal));
            pt1:=comp_expr(not(ignore_equal));
-           if (pt1^.treetype=typen) and (token<>POINTPOINT) then
-             begin
-                { a simple type renaming }
-                p:=pt1^.resulttype;
-             end
-           else
+           do_firstpass(pt1);
+           if (token=POINTPOINT) then
              begin
              begin
-                { range type }
-                consume(POINTPOINT);
-                { range type declaration }
-                do_firstpass(pt1);
-                pt2:=comp_expr(not(ignore_equal));
-                do_firstpass(pt2);
-                { valid expression ? }
-                if (pt1^.treetype<>ordconstn) or (pt2^.treetype<>ordconstn) then
-                  Message(sym_e_error_in_type_def)
-                else
-                  begin
-                  { Check bounds }
-                    if pt2^.value<pt1^.value then
-                      Message(cg_e_upper_lower_than_lower)
-                    else
+               consume(POINTPOINT);
+               { get high value of range }
+               pt2:=comp_expr(not(ignore_equal));
+               do_firstpass(pt2);
+               { both must be evaluated to constants now }
+               if (pt1^.treetype<>ordconstn) or (pt2^.treetype<>ordconstn) then
+                 Message(sym_e_error_in_type_def)
+               else
+                 begin
+                 { Check bounds }
+                   if pt2^.value<pt1^.value then
+                     Message(cg_e_upper_lower_than_lower)
+                   else
                      begin
                      begin
                      { is one an enum ? }
                      { is one an enum ? }
                        if (pt1^.resulttype^.deftype=enumdef) or (pt2^.resulttype^.deftype=enumdef) then
                        if (pt1^.resulttype^.deftype=enumdef) or (pt2^.resulttype^.deftype=enumdef) then
-                        begin
-                        { both must be the have the same (enumdef) definition, else its a type mismatch }
-                          if (pt1^.resulttype=pt2^.resulttype) then
-                            p:=new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value))
-                          else
-                            Message(type_e_mismatch);
-                        end
+                         begin
+                         { both must be the have the same (enumdef) definition, else its a type mismatch }
+                           if (pt1^.resulttype=pt2^.resulttype) then
+                             p:=new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value))
+                           else
+                             Message(type_e_mismatch);
+                         end
                        else
                        else
-                        begin
-                        { both must be are orddefs, create an uauto orddef }
-                          p:=new(porddef,init(uauto,pt1^.value,pt2^.value));
-                        end;
+                         begin
+                         { both must be are orddefs, create an uauto orddef }
+                           p:=new(porddef,init(uauto,pt1^.value,pt2^.value));
+                         end;
                      end;
                      end;
-                  end;
-                disposetree(pt2);
+                 end;
+               disposetree(pt2);
+             end
+           else
+             begin
+               { a simple type renaming }
+               if (pt1^.treetype=typen) then
+                 p:=pt1^.resulttype
+               else
+                 Message(sym_e_error_in_type_def);
              end;
              end;
            disposetree(pt1);
            disposetree(pt1);
         end;
         end;
@@ -2037,7 +2041,11 @@ unit pdecl;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.60  1998-09-30 07:40:33  florian
+  Revision 1.61  1998-10-02 09:23:24  peter
+    * fixed error msg with type l=<var>
+    * block_type bt_const is now set in read_const_dec
+
+  Revision 1.60  1998/09/30 07:40:33  florian
     * better error recovering
     * better error recovering
 
 
   Revision 1.59  1998/09/26 17:45:33  peter
   Revision 1.59  1998/09/26 17:45:33  peter