Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/par-ch5.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- P A R . C H 5 -- 5 -- P A R . C H 5 --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
356 356
357 -- Terminate if Eftm set or if the ELSIF is to the left 357 -- Terminate if Eftm set or if the ELSIF is to the left
358 -- of the expected column of the end for this sequence 358 -- of the expected column of the end for this sequence
359 359
360 if SS_Flags.Eftm 360 if SS_Flags.Eftm
361 or else Start_Column < Scope.Table (Scope.Last).Ecol 361 or else Start_Column < Scopes (Scope.Last).Ecol
362 then 362 then
363 Test_Statement_Required; 363 Test_Statement_Required;
364 exit; 364 exit;
365 365
366 -- Otherwise complain and skip past ELSIF Condition then 366 -- Otherwise complain and skip past ELSIF Condition then
379 379
380 -- Terminate if Eltm set or if the else is to the left 380 -- Terminate if Eltm set or if the else is to the left
381 -- of the expected column of the end for this sequence 381 -- of the expected column of the end for this sequence
382 382
383 if SS_Flags.Eltm 383 if SS_Flags.Eltm
384 or else Start_Column < Scope.Table (Scope.Last).Ecol 384 or else Start_Column < Scopes (Scope.Last).Ecol
385 then 385 then
386 Test_Statement_Required; 386 Test_Statement_Required;
387 exit; 387 exit;
388 388
389 -- Otherwise complain and skip past else 389 -- Otherwise complain and skip past else
403 -- the expected column of the end for this sequence, then we 403 -- the expected column of the end for this sequence, then we
404 -- assume it belongs to the current sequence, even though it 404 -- assume it belongs to the current sequence, even though it
405 -- is not permitted. 405 -- is not permitted.
406 406
407 if not SS_Flags.Extm and then 407 if not SS_Flags.Extm and then
408 Start_Column >= Scope.Table (Scope.Last).Ecol 408 Start_Column >= Scopes (Scope.Last).Ecol
409 409
410 then 410 then
411 Error_Msg_SC ("exception handler not permitted here"); 411 Error_Msg_SC ("exception handler not permitted here");
412 Scan; -- past EXCEPTION 412 Scan; -- past EXCEPTION
413 Discard_Junk_List (Parse_Exception_Handlers); 413 Discard_Junk_List (Parse_Exception_Handlers);
425 425
426 -- Terminate if Ortm set or if the or is to the left of the 426 -- Terminate if Ortm set or if the or is to the left of the
427 -- expected column of the end for this sequence. 427 -- expected column of the end for this sequence.
428 428
429 if SS_Flags.Ortm 429 if SS_Flags.Ortm
430 or else Start_Column < Scope.Table (Scope.Last).Ecol 430 or else Start_Column < Scopes (Scope.Last).Ecol
431 then 431 then
432 Test_Statement_Required; 432 Test_Statement_Required;
433 exit; 433 exit;
434 434
435 -- Otherwise complain and skip past or 435 -- Otherwise complain and skip past or
465 => 465 =>
466 -- Terminate if Whtm set or if the WHEN is to the left of 466 -- Terminate if Whtm set or if the WHEN is to the left of
467 -- the expected column of the end for this sequence. 467 -- the expected column of the end for this sequence.
468 468
469 if SS_Flags.Whtm 469 if SS_Flags.Whtm
470 or else Start_Column < Scope.Table (Scope.Last).Ecol 470 or else Start_Column < Scopes (Scope.Last).Ecol
471 then 471 then
472 Test_Statement_Required; 472 Test_Statement_Required;
473 exit; 473 exit;
474 474
475 -- Otherwise complain and skip when Choice {| Choice} => 475 -- Otherwise complain and skip when Choice {| Choice} =>
1140 end Add_Elsif_Part; 1140 end Add_Elsif_Part;
1141 1141
1142 procedure Check_If_Column is 1142 procedure Check_If_Column is
1143 begin 1143 begin
1144 if RM_Column_Check and then Token_Is_At_Start_Of_Line 1144 if RM_Column_Check and then Token_Is_At_Start_Of_Line
1145 and then Start_Column /= Scope.Table (Scope.Last).Ecol 1145 and then Start_Column /= Scopes (Scope.Last).Ecol
1146 then 1146 then
1147 Error_Msg_Col := Scope.Table (Scope.Last).Ecol; 1147 Error_Msg_Col := Scopes (Scope.Last).Ecol;
1148 Error_Msg_SC ("(style) this token should be@"); 1148 Error_Msg_SC ("(style) this token should be@");
1149 end if; 1149 end if;
1150 end Check_If_Column; 1150 end Check_If_Column;
1151 1151
1152 procedure Check_Then_Column is 1152 procedure Check_Then_Column is
1190 1190
1191 begin 1191 begin
1192 If_Node := New_Node (N_If_Statement, Token_Ptr); 1192 If_Node := New_Node (N_If_Statement, Token_Ptr);
1193 1193
1194 Push_Scope_Stack; 1194 Push_Scope_Stack;
1195 Scope.Table (Scope.Last).Etyp := E_If; 1195 Scopes (Scope.Last).Etyp := E_If;
1196 Scope.Table (Scope.Last).Ecol := Start_Column; 1196 Scopes (Scope.Last).Ecol := Start_Column;
1197 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1197 Scopes (Scope.Last).Sloc := Token_Ptr;
1198 Scope.Table (Scope.Last).Labl := Error; 1198 Scopes (Scope.Last).Labl := Error;
1199 Scope.Table (Scope.Last).Node := If_Node; 1199 Scopes (Scope.Last).Node := If_Node;
1200 1200
1201 if Token = Tok_If then 1201 if Token = Tok_If then
1202 Loc := Token_Ptr; 1202 Loc := Token_Ptr;
1203 Scan; -- past IF 1203 Scan; -- past IF
1204 Set_Condition (If_Node, P_Condition); 1204 Set_Condition (If_Node, P_Condition);
1348 1348
1349 begin 1349 begin
1350 Case_Node := New_Node (N_Case_Statement, Token_Ptr); 1350 Case_Node := New_Node (N_Case_Statement, Token_Ptr);
1351 1351
1352 Push_Scope_Stack; 1352 Push_Scope_Stack;
1353 Scope.Table (Scope.Last).Etyp := E_Case; 1353 Scopes (Scope.Last).Etyp := E_Case;
1354 Scope.Table (Scope.Last).Ecol := Start_Column; 1354 Scopes (Scope.Last).Ecol := Start_Column;
1355 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1355 Scopes (Scope.Last).Sloc := Token_Ptr;
1356 Scope.Table (Scope.Last).Labl := Error; 1356 Scopes (Scope.Last).Labl := Error;
1357 Scope.Table (Scope.Last).Node := Case_Node; 1357 Scopes (Scope.Last).Node := Case_Node;
1358 1358
1359 Scan; -- past CASE 1359 Scan; -- past CASE
1360 Set_Expression (Case_Node, P_Expression_No_Right_Paren); 1360 Set_Expression (Case_Node, P_Expression_No_Right_Paren);
1361 TF_Is; 1361 TF_Is;
1362 1362
1390 -- with respect to the current case statement, then the best guess is 1390 -- with respect to the current case statement, then the best guess is
1391 -- that we are still supposed to be inside the case statement. We 1391 -- that we are still supposed to be inside the case statement. We
1392 -- complain about the missing WHEN, and discard the junk statements. 1392 -- complain about the missing WHEN, and discard the junk statements.
1393 1393
1394 elsif not Token_Is_At_Start_Of_Line 1394 elsif not Token_Is_At_Start_Of_Line
1395 or else Start_Column > Scope.Table (Scope.Last).Ecol 1395 or else Start_Column > Scopes (Scope.Last).Ecol
1396 then 1396 then
1397 Error_Msg_BC ("WHEN (case statement alternative) expected"); 1397 Error_Msg_BC ("WHEN (case statement alternative) expected");
1398 1398
1399 -- Here is a possibility for infinite looping if we don't make 1399 -- Here is a possibility for infinite looping if we don't make
1400 -- progress. So try to process statements, otherwise exit 1400 -- progress. So try to process statements, otherwise exit
1488 Loop_Node : Node_Id; 1488 Loop_Node : Node_Id;
1489 Created_Name : Node_Id; 1489 Created_Name : Node_Id;
1490 1490
1491 begin 1491 begin
1492 Push_Scope_Stack; 1492 Push_Scope_Stack;
1493 Scope.Table (Scope.Last).Labl := Loop_Name; 1493 Scopes (Scope.Last).Labl := Loop_Name;
1494 Scope.Table (Scope.Last).Ecol := Start_Column; 1494 Scopes (Scope.Last).Ecol := Start_Column;
1495 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1495 Scopes (Scope.Last).Sloc := Token_Ptr;
1496 Scope.Table (Scope.Last).Etyp := E_Loop; 1496 Scopes (Scope.Last).Etyp := E_Loop;
1497 1497
1498 Loop_Node := New_Node (N_Loop_Statement, Token_Ptr); 1498 Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1499 TF_Loop; 1499 TF_Loop;
1500 1500
1501 if No (Loop_Name) then 1501 if No (Loop_Name) then
1502 Created_Name := 1502 Created_Name :=
1503 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L')); 1503 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1504 Set_Comes_From_Source (Created_Name, False); 1504 Set_Comes_From_Source (Created_Name, False);
1505 Set_Has_Created_Identifier (Loop_Node, True); 1505 Set_Has_Created_Identifier (Loop_Node, True);
1506 Set_Identifier (Loop_Node, Created_Name); 1506 Set_Identifier (Loop_Node, Created_Name);
1507 Scope.Table (Scope.Last).Labl := Created_Name; 1507 Scopes (Scope.Last).Labl := Created_Name;
1508 else 1508 else
1509 Set_Identifier (Loop_Node, Loop_Name); 1509 Set_Identifier (Loop_Node, Loop_Name);
1510 end if; 1510 end if;
1511 1511
1512 Append_Elmt (Loop_Node, Label_List); 1512 Append_Elmt (Loop_Node, Label_List);
1534 Created_Name : Node_Id; 1534 Created_Name : Node_Id;
1535 Spec : Node_Id; 1535 Spec : Node_Id;
1536 1536
1537 begin 1537 begin
1538 Push_Scope_Stack; 1538 Push_Scope_Stack;
1539 Scope.Table (Scope.Last).Labl := Loop_Name; 1539 Scopes (Scope.Last).Labl := Loop_Name;
1540 Scope.Table (Scope.Last).Ecol := Start_Column; 1540 Scopes (Scope.Last).Ecol := Start_Column;
1541 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1541 Scopes (Scope.Last).Sloc := Token_Ptr;
1542 Scope.Table (Scope.Last).Etyp := E_Loop; 1542 Scopes (Scope.Last).Etyp := E_Loop;
1543 1543
1544 Loop_For_Flag := (Prev_Token = Tok_Loop); 1544 Loop_For_Flag := (Prev_Token = Tok_Loop);
1545 Scan; -- past FOR 1545 Scan; -- past FOR
1546 Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); 1546 Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
1547 Spec := P_Loop_Parameter_Specification; 1547 Spec := P_Loop_Parameter_Specification;
1573 Created_Name := 1573 Created_Name :=
1574 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L')); 1574 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1575 Set_Comes_From_Source (Created_Name, False); 1575 Set_Comes_From_Source (Created_Name, False);
1576 Set_Has_Created_Identifier (Loop_Node, True); 1576 Set_Has_Created_Identifier (Loop_Node, True);
1577 Set_Identifier (Loop_Node, Created_Name); 1577 Set_Identifier (Loop_Node, Created_Name);
1578 Scope.Table (Scope.Last).Labl := Created_Name; 1578 Scopes (Scope.Last).Labl := Created_Name;
1579 else 1579 else
1580 Set_Identifier (Loop_Node, Loop_Name); 1580 Set_Identifier (Loop_Node, Loop_Name);
1581 end if; 1581 end if;
1582 1582
1583 TF_Loop; 1583 TF_Loop;
1605 Loop_While_Flag : Boolean; 1605 Loop_While_Flag : Boolean;
1606 Created_Name : Node_Id; 1606 Created_Name : Node_Id;
1607 1607
1608 begin 1608 begin
1609 Push_Scope_Stack; 1609 Push_Scope_Stack;
1610 Scope.Table (Scope.Last).Labl := Loop_Name; 1610 Scopes (Scope.Last).Labl := Loop_Name;
1611 Scope.Table (Scope.Last).Ecol := Start_Column; 1611 Scopes (Scope.Last).Ecol := Start_Column;
1612 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1612 Scopes (Scope.Last).Sloc := Token_Ptr;
1613 Scope.Table (Scope.Last).Etyp := E_Loop; 1613 Scopes (Scope.Last).Etyp := E_Loop;
1614 1614
1615 Loop_While_Flag := (Prev_Token = Tok_Loop); 1615 Loop_While_Flag := (Prev_Token = Tok_Loop);
1616 Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); 1616 Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
1617 Scan; -- past WHILE 1617 Scan; -- past WHILE
1618 Set_Condition (Iter_Scheme_Node, P_Condition); 1618 Set_Condition (Iter_Scheme_Node, P_Condition);
1639 Created_Name := 1639 Created_Name :=
1640 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L')); 1640 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1641 Set_Comes_From_Source (Created_Name, False); 1641 Set_Comes_From_Source (Created_Name, False);
1642 Set_Has_Created_Identifier (Loop_Node, True); 1642 Set_Has_Created_Identifier (Loop_Node, True);
1643 Set_Identifier (Loop_Node, Created_Name); 1643 Set_Identifier (Loop_Node, Created_Name);
1644 Scope.Table (Scope.Last).Labl := Created_Name; 1644 Scopes (Scope.Last).Labl := Created_Name;
1645 else 1645 else
1646 Set_Identifier (Loop_Node, Loop_Name); 1646 Set_Identifier (Loop_Node, Loop_Name);
1647 end if; 1647 end if;
1648 1648
1649 Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq)); 1649 Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1803 1803
1804 begin 1804 begin
1805 Block_Node := New_Node (N_Block_Statement, Token_Ptr); 1805 Block_Node := New_Node (N_Block_Statement, Token_Ptr);
1806 1806
1807 Push_Scope_Stack; 1807 Push_Scope_Stack;
1808 Scope.Table (Scope.Last).Etyp := E_Name; 1808 Scopes (Scope.Last).Etyp := E_Name;
1809 Scope.Table (Scope.Last).Lreq := Present (Block_Name); 1809 Scopes (Scope.Last).Lreq := Present (Block_Name);
1810 Scope.Table (Scope.Last).Ecol := Start_Column; 1810 Scopes (Scope.Last).Ecol := Start_Column;
1811 Scope.Table (Scope.Last).Labl := Block_Name; 1811 Scopes (Scope.Last).Labl := Block_Name;
1812 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1812 Scopes (Scope.Last).Sloc := Token_Ptr;
1813 1813
1814 Scan; -- past DECLARE 1814 Scan; -- past DECLARE
1815 1815
1816 if No (Block_Name) then 1816 if No (Block_Name) then
1817 Created_Name := 1817 Created_Name :=
1818 Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B')); 1818 Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
1819 Set_Comes_From_Source (Created_Name, False); 1819 Set_Comes_From_Source (Created_Name, False);
1820 Set_Has_Created_Identifier (Block_Node, True); 1820 Set_Has_Created_Identifier (Block_Node, True);
1821 Set_Identifier (Block_Node, Created_Name); 1821 Set_Identifier (Block_Node, Created_Name);
1822 Scope.Table (Scope.Last).Labl := Created_Name; 1822 Scopes (Scope.Last).Labl := Created_Name;
1823 else 1823 else
1824 Set_Identifier (Block_Node, Block_Name); 1824 Set_Identifier (Block_Node, Block_Name);
1825 end if; 1825 end if;
1826 1826
1827 Append_Elmt (Block_Node, Label_List); 1827 Append_Elmt (Block_Node, Label_List);
1846 1846
1847 begin 1847 begin
1848 Block_Node := New_Node (N_Block_Statement, Token_Ptr); 1848 Block_Node := New_Node (N_Block_Statement, Token_Ptr);
1849 1849
1850 Push_Scope_Stack; 1850 Push_Scope_Stack;
1851 Scope.Table (Scope.Last).Etyp := E_Name; 1851 Scopes (Scope.Last).Etyp := E_Name;
1852 Scope.Table (Scope.Last).Lreq := Present (Block_Name); 1852 Scopes (Scope.Last).Lreq := Present (Block_Name);
1853 Scope.Table (Scope.Last).Ecol := Start_Column; 1853 Scopes (Scope.Last).Ecol := Start_Column;
1854 Scope.Table (Scope.Last).Labl := Block_Name; 1854 Scopes (Scope.Last).Labl := Block_Name;
1855 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1855 Scopes (Scope.Last).Sloc := Token_Ptr;
1856 1856
1857 if No (Block_Name) then 1857 if No (Block_Name) then
1858 Created_Name := 1858 Created_Name :=
1859 Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B')); 1859 Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
1860 Set_Comes_From_Source (Created_Name, False); 1860 Set_Comes_From_Source (Created_Name, False);
1861 Set_Has_Created_Identifier (Block_Node, True); 1861 Set_Has_Created_Identifier (Block_Node, True);
1862 Set_Identifier (Block_Node, Created_Name); 1862 Set_Identifier (Block_Node, Created_Name);
1863 Scope.Table (Scope.Last).Labl := Created_Name; 1863 Scopes (Scope.Last).Labl := Created_Name;
1864 else 1864 else
1865 Set_Identifier (Block_Node, Block_Name); 1865 Set_Identifier (Block_Node, Block_Name);
1866 end if; 1866 end if;
1867 1867
1868 Append_Elmt (Block_Node, Label_List); 1868 Append_Elmt (Block_Node, Label_List);
1869 1869
1870 Scope.Table (Scope.Last).Ecol := Start_Column; 1870 Scopes (Scope.Last).Ecol := Start_Column;
1871 Scope.Table (Scope.Last).Sloc := Token_Ptr; 1871 Scopes (Scope.Last).Sloc := Token_Ptr;
1872 Scan; -- past BEGIN 1872 Scan; -- past BEGIN
1873 Set_Handled_Statement_Sequence 1873 Set_Handled_Statement_Sequence
1874 (Block_Node, P_Handled_Sequence_Of_Statements); 1874 (Block_Node, P_Handled_Sequence_Of_Statements);
1875 End_Statements (Handled_Statement_Sequence (Block_Node)); 1875 End_Statements (Handled_Statement_Sequence (Block_Node));
1876 return Block_Node; 1876 return Block_Node;
1911 1911
1912 begin 1912 begin
1913 if not Token_Is_At_Start_Of_Line then 1913 if not Token_Is_At_Start_Of_Line then
1914 return False; 1914 return False;
1915 1915
1916 elsif Scope.Table (Scope.Last).Etyp /= E_Case then 1916 elsif Scopes (Scope.Last).Etyp /= E_Case then
1917 return False; 1917 return False;
1918 1918
1919 else 1919 else
1920 Save_Scan_State (State); 1920 Save_Scan_State (State);
1921 Scan; -- past WHEN 1921 Scan; -- past WHEN
1944 -- This EXIT has no name, so check that 1944 -- This EXIT has no name, so check that
1945 -- the innermost loop is unnamed too. 1945 -- the innermost loop is unnamed too.
1946 1946
1947 Check_No_Exit_Name : 1947 Check_No_Exit_Name :
1948 for J in reverse 1 .. Scope.Last loop 1948 for J in reverse 1 .. Scope.Last loop
1949 if Scope.Table (J).Etyp = E_Loop then 1949 if Scopes (J).Etyp = E_Loop then
1950 if Present (Scope.Table (J).Labl) 1950 if Present (Scopes (J).Labl)
1951 and then Comes_From_Source (Scope.Table (J).Labl) 1951 and then Comes_From_Source (Scopes (J).Labl)
1952 then 1952 then
1953 -- Innermost loop in fact had a name, style check fails 1953 -- Innermost loop in fact had a name, style check fails
1954 1954
1955 Style.No_Exit_Name (Scope.Table (J).Labl); 1955 Style.No_Exit_Name (Scopes (J).Labl);
1956 end if; 1956 end if;
1957 1957
1958 exit Check_No_Exit_Name; 1958 exit Check_No_Exit_Name;
1959 end if; 1959 end if;
1960 end loop Check_No_Exit_Name; 1960 end loop Check_No_Exit_Name;
2152 if Token = Tok_Begin then 2152 if Token = Tok_Begin then
2153 if Style_Check then 2153 if Style_Check then
2154 Style.Check_Indentation; 2154 Style.Check_Indentation;
2155 end if; 2155 end if;
2156 2156
2157 Error_Msg_Col := Scope.Table (Scope.Last).Ecol; 2157 Error_Msg_Col := Scopes (Scope.Last).Ecol;
2158 2158
2159 if RM_Column_Check 2159 if RM_Column_Check
2160 and then Token_Is_At_Start_Of_Line 2160 and then Token_Is_At_Start_Of_Line
2161 and then Start_Column /= Error_Msg_Col 2161 and then Start_Column /= Error_Msg_Col
2162 then 2162 then
2163 Error_Msg_SC ("(style) BEGIN in wrong column, should be@"); 2163 Error_Msg_SC ("(style) BEGIN in wrong column, should be@");
2164 2164
2165 else 2165 else
2166 Scope.Table (Scope.Last).Ecol := Start_Column; 2166 Scopes (Scope.Last).Ecol := Start_Column;
2167 end if; 2167 end if;
2168 2168
2169 Scope.Table (Scope.Last).Sloc := Token_Ptr; 2169 Scopes (Scope.Last).Sloc := Token_Ptr;
2170 Scan; -- past BEGIN 2170 Scan; -- past BEGIN
2171 Set_Handled_Statement_Sequence (Parent, 2171 Set_Handled_Statement_Sequence (Parent,
2172 P_Handled_Sequence_Of_Statements); 2172 P_Handled_Sequence_Of_Statements);
2173 2173
2174 -- No BEGIN present 2174 -- No BEGIN present
2181 -- IS, and the current token is END, then we simply confirm 2181 -- IS, and the current token is END, then we simply confirm
2182 -- the suspicion, and do not require a BEGIN to be present 2182 -- the suspicion, and do not require a BEGIN to be present
2183 2183
2184 if Parent_Nkind = N_Subprogram_Body 2184 if Parent_Nkind = N_Subprogram_Body
2185 and then Token = Tok_End 2185 and then Token = Tok_End
2186 and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is 2186 and then Scopes (Scope.Last).Etyp = E_Suspicious_Is
2187 then 2187 then
2188 Scope.Table (Scope.Last).Etyp := E_Bad_Is; 2188 Scopes (Scope.Last).Etyp := E_Bad_Is;
2189 2189
2190 -- Otherwise BEGIN is not required for a package body, so we 2190 -- Otherwise BEGIN is not required for a package body, so we
2191 -- don't mind if it is missing, but we do construct a dummy 2191 -- don't mind if it is missing, but we do construct a dummy
2192 -- one (so that we have somewhere to set End_Label). 2192 -- one (so that we have somewhere to set End_Label).
2193 2193
2209 else 2209 else
2210 Set_Null_HSS (Parent); 2210 Set_Null_HSS (Parent);
2211 2211
2212 -- Prepare to issue error message 2212 -- Prepare to issue error message
2213 2213
2214 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; 2214 Error_Msg_Sloc := Scopes (Scope.Last).Sloc;
2215 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; 2215 Error_Msg_Node_1 := Scopes (Scope.Last).Labl;
2216 2216
2217 -- Now issue appropriate message 2217 -- Now issue appropriate message
2218 2218
2219 if Parent_Nkind = N_Block_Statement then 2219 if Parent_Nkind = N_Block_Statement then
2220 Missing_Begin ("missing BEGIN for DECLARE#!"); 2220 Missing_Begin ("missing BEGIN for DECLARE#!");
2270 2270
2271 -- We know that End_Statements removed an entry from the scope stack 2271 -- We know that End_Statements removed an entry from the scope stack
2272 -- (because it is required to do so under all circumstances). We can 2272 -- (because it is required to do so under all circumstances). We can
2273 -- therefore reference the entry it removed one past the stack top. 2273 -- therefore reference the entry it removed one past the stack top.
2274 -- What we are interested in is whether it was a case of a bad IS. 2274 -- What we are interested in is whether it was a case of a bad IS.
2275 -- We can't call Scopes here.
2275 2276
2276 if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then 2277 if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then
2277 Error_Msg -- CODEFIX 2278 Error_Msg -- CODEFIX
2278 ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is); 2279 ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
2279 Set_Bad_Is_Detected (Parent, True); 2280 Set_Bad_Is_Detected (Parent, True);