Browse Source

* directives are allowed in (* *)
* fixed parsing of (* between conditional code

peter 26 years ago
parent
commit
382d5bd835
1 changed files with 56 additions and 7 deletions
  1. 56 7
      compiler/scanner.pas

+ 56 - 7
compiler/scanner.pas

@@ -44,6 +44,8 @@ unit scanner;
 
 
 
 
     type
     type
+       tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
+
        pmacrobuffer = ^tmacrobuffer;
        pmacrobuffer = ^tmacrobuffer;
        tmacrobuffer = array[0..maxmacrolen-1] of char;
        tmacrobuffer = array[0..maxmacrolen-1] of char;
 
 
@@ -125,7 +127,7 @@ unit scanner;
         orgpattern,
         orgpattern,
         pattern        : string;
         pattern        : string;
         current_scanner : pscannerfile;
         current_scanner : pscannerfile;
-
+        aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
 
 
 implementation
 implementation
 
 
@@ -736,12 +738,26 @@ implementation
         i:=0;
         i:=0;
         repeat
         repeat
           case c of
           case c of
-           '}' : begin
+           '}' :
+             if aktcommentstyle=comment_tp then
+              begin
+                readchar;
+                dec_comment_level;
+                break;
+              end;
+           '*' :
+             if aktcommentstyle=comment_oldtp then
+              begin
+                readchar;
+                if c=')' then
+                 begin
                    readchar;
                    readchar;
                    dec_comment_level;
                    dec_comment_level;
                    break;
                    break;
                  end;
                  end;
-           #26 : Message(scan_f_end_of_file);
+              end;
+           #26 :
+              Message(scan_f_end_of_file);
           else
           else
             begin
             begin
               if (i<255) then
               if (i<255) then
@@ -839,8 +855,29 @@ implementation
                  if found=1 then
                  if found=1 then
                   found:=2;
                   found:=2;
                end;
                end;
+             '''' :
+               if (m_tp in aktmodeswitches) or
+                  (m_delphi in aktmodeswitches) then
+                begin
+                  repeat
+                    readchar;
+                    case c of
+                      #26 :
+                        Message(scan_f_end_of_file);
+                      newline :
+                        break;
+                      '''' :
+                        begin
+                          readchar;
+                          if c<>'''' then
+                           break;
+                        end;
+                    end;
+                  until false;
+                end;
              '(' :
              '(' :
-               if (m_tp in aktmodeswitches) then
+               if (m_tp in aktmodeswitches) or
+                  (m_delphi in aktmodeswitches) then
                 begin
                 begin
                   readchar;
                   readchar;
                   if c='*' then
                   if c='*' then
@@ -873,6 +910,7 @@ implementation
 
 
     procedure tscannerfile.skipcomment;
     procedure tscannerfile.skipcomment;
       begin
       begin
+        aktcommentstyle:=comment_tp;
         readchar;
         readchar;
         inc_comment_level;
         inc_comment_level;
       { handle compiler switches }
       { handle compiler switches }
@@ -897,11 +935,13 @@ implementation
             #13 : linebreak;
             #13 : linebreak;
            end;
            end;
          end;
          end;
+        aktcommentstyle:=comment_none;
       end;
       end;
 
 
 
 
     procedure tscannerfile.skipdelphicomment;
     procedure tscannerfile.skipdelphicomment;
       begin
       begin
+        aktcommentstyle:=comment_delphi;
         inc_comment_level;
         inc_comment_level;
         readchar;
         readchar;
       { this is currently not supported }
       { this is currently not supported }
@@ -915,6 +955,7 @@ implementation
            readchar;
            readchar;
          end;
          end;
         dec_comment_level;
         dec_comment_level;
+        aktcommentstyle:=comment_none;
       end;
       end;
 
 
 
 
@@ -922,11 +963,12 @@ implementation
       var
       var
         found : longint;
         found : longint;
       begin
       begin
+        aktcommentstyle:=comment_oldtp;
         inc_comment_level;
         inc_comment_level;
         readchar;
         readchar;
       { this is currently not supported }
       { this is currently not supported }
-        if c='$' then
-         Message(scan_e_wrong_styled_switch);
+        if (c='$') then
+         handledirectives;
       { skip comment }
       { skip comment }
         while (comment_level>0) do
         while (comment_level>0) do
          begin
          begin
@@ -969,6 +1011,7 @@ implementation
              end;
              end;
            until (found=2);
            until (found=2);
          end;
          end;
+        aktcommentstyle:=comment_none;
       end;
       end;
 
 
 
 
@@ -976,6 +1019,7 @@ implementation
       var
       var
         found : longint;
         found : longint;
       begin
       begin
+        aktcommentstyle:=comment_c;
         inc_comment_level;
         inc_comment_level;
         readchar;
         readchar;
       { this is currently not supported }
       { this is currently not supported }
@@ -1023,6 +1067,7 @@ implementation
              end;
              end;
            until (found=2);
            until (found=2);
          end;
          end;
+        aktcommentstyle:=comment_none;
       end;
       end;
 
 
 
 
@@ -1673,7 +1718,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.87  1999-07-18 10:20:02  florian
+  Revision 1.88  1999-07-24 11:20:59  peter
+    * directives are allowed in (* *)
+    * fixed parsing of (* between conditional code
+
+  Revision 1.87  1999/07/18 10:20:02  florian
     * made it compilable with Dlephi 4 again
     * made it compilable with Dlephi 4 again
     + fixed problem with large stack allocations on win32
     + fixed problem with large stack allocations on win32