with Stringt; use Stringt;
separate (Scn)
procedure Slit is
Delimiter : Character;
C : Character;
Code : Char_Code;
Err : Boolean;
String_Literal_Id : String_Id;
Wide_Character_Found : Boolean := False;
procedure Error_Bad_String_Char;
procedure Error_Unterminated_String;
procedure Set_String;
procedure Error_Bad_String_Char is
C : constant Character := Source (Scan_Ptr);
begin
if C = HT then
Error_Msg_S ("horizontal tab not allowed in string");
elsif C = VT or else C = FF then
Error_Msg_S ("format effector not allowed in string");
elsif C in Upper_Half_Character then
Error_Msg_S ("(Ada 83) upper half character not allowed");
else
Error_Msg_S ("control character not allowed in string");
end if;
end Error_Bad_String_Char;
procedure Error_Unterminated_String is
begin
while Source (Scan_Ptr - 1) = ' '
or else Source (Scan_Ptr - 1) = '&'
loop
Scan_Ptr := Scan_Ptr - 1;
Unstore_String_Char;
end loop;
if Delimiter /= '''
and then Source (Scan_Ptr - 1) = '''
then
Unstore_String_Char;
Error_Msg ("incorrect string terminator character", Scan_Ptr - 1);
return;
end if;
if Source (Scan_Ptr - 1) = ';' then
Scan_Ptr := Scan_Ptr - 1;
Unstore_String_Char;
if Source (Scan_Ptr - 1) = ')' then
Scan_Ptr := Scan_Ptr - 1;
Unstore_String_Char;
end if;
end if;
Error_Msg_S ("missing string quote");
end Error_Unterminated_String;
procedure Set_String is
Slen : Int := Int (Scan_Ptr - Token_Ptr - 2);
C1 : Character;
C2 : Character;
C3 : Character;
begin
if Slen = 1 then
C1 := Source (Token_Ptr + 1);
case C1 is
when '=' =>
Token_Name := Name_Op_Eq;
when '>' =>
Token_Name := Name_Op_Gt;
when '<' =>
Token_Name := Name_Op_Lt;
when '+' =>
Token_Name := Name_Op_Add;
when '-' =>
Token_Name := Name_Op_Subtract;
when '&' =>
Token_Name := Name_Op_Concat;
when '*' =>
Token_Name := Name_Op_Multiply;
when '/' =>
Token_Name := Name_Op_Divide;
when others =>
null;
end case;
elsif Slen = 2 then
C1 := Source (Token_Ptr + 1);
C2 := Source (Token_Ptr + 2);
if C1 = '*' and then C2 = '*' then
Token_Name := Name_Op_Expon;
elsif C2 = '=' then
if C1 = '/' then
Token_Name := Name_Op_Ne;
elsif C1 = '<' then
Token_Name := Name_Op_Le;
elsif C1 = '>' then
Token_Name := Name_Op_Ge;
end if;
elsif (C1 = 'O' or else C1 = 'o') and then (C2 = 'R' or else C2 = 'r')
then
Token_Name := Name_Op_Or;
end if;
elsif Slen = 3 then
C1 := Source (Token_Ptr + 1);
C2 := Source (Token_Ptr + 2);
C3 := Source (Token_Ptr + 3);
if (C1 = 'A' or else C1 = 'a') and then (C2 = 'N' or else C2 = 'n') and then
(C3 = 'D' or else C3 = 'd')
then
Token_Name := Name_Op_And;
elsif (C1 = 'A' or else C1 = 'a') and then (C2 = 'B' or else C2 = 'b') and then
(C3 = 'S' or else C3 = 's')
then
Token_Name := Name_Op_Abs;
elsif (C1 = 'M' or else C1 = 'm') and then (C2 = 'O' or else C2 = 'o') and then
(C3 = 'D' or else C3 = 'd')
then
Token_Name := Name_Op_Mod;
elsif (C1 = 'N' or else C1 = 'n') and then (C2 = 'O' or else C2 = 'o') and then
(C3 = 'T' or else C3 = 't')
then
Token_Name := Name_Op_Not;
elsif (C1 = 'R' or else C1 = 'r') and then (C2 = 'E' or else C2 = 'e') and then
(C3 = 'M' or else C3 = 'm')
then
Token_Name := Name_Op_Rem;
elsif (C1 = 'X' or else C1 = 'x') and then (C2 = 'O' or else C2 = 'o') and then
(C3 = 'R' or else C3 = 'r')
then
Token_Name := Name_Op_Xor;
end if;
end if;
if Token_Name = Error_Name then
Token := Tok_String_Literal;
Token_Node := New_Node (N_String_Literal, Token_Ptr);
Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
else
Token := Tok_Operator_Symbol;
Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
Set_Chars (Token_Node, Token_Name);
end if;
Set_Strval (Token_Node, String_Literal_Id);
end Set_String;
begin
Delimiter := Source (Scan_Ptr);
Accumulate_Checksum (Delimiter);
Start_String;
Scan_Ptr := Scan_Ptr + 1;
loop
C := Source (Scan_Ptr);
if C = Delimiter then
Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
exit when Source (Scan_Ptr) /= Delimiter;
Code := Get_Char_Code (C);
Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
else
if C = '"' and then Delimiter = '%' then
Error_Msg_S ("quote not allowed in percent delimited string");
Code := Get_Char_Code (C);
Scan_Ptr := Scan_Ptr + 1;
elsif (C = ESC
and then
Wide_Character_Encoding_Method in WC_ESC_Encoding_Method)
or else
(C in Upper_Half_Character
and then
Upper_Half_Encoding)
or else
(C = '['
and then
Source (Scan_Ptr + 1) = '"'
and then
Identifier_Char (Source (Scan_Ptr + 2)))
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
Code := Get_Char_Code (' ');
end if;
else
Accumulate_Checksum (C);
if C not in Graphic_Character then
if C in Line_Terminator then
Error_Unterminated_String;
exit;
elsif C in Upper_Half_Character then
if Ada_83 then
Error_Bad_String_Char;
end if;
else
Error_Bad_String_Char;
end if;
end if;
Code := Get_Char_Code (C);
Scan_Ptr := Scan_Ptr + 1;
end if;
end if;
Store_String_Char (Code);
if not In_Character_Range (Code) then
Wide_Character_Found := True;
end if;
end loop;
String_Literal_Id := End_String;
Set_String;
return;
end Slit;