comparison gcc/ada/sem_dim.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 4 -- --
5 -- S E M _ D I M -- 5 -- S E M _ D I M --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2011-2017, Free Software Foundation, Inc. -- 9 -- Copyright (C) 2011-2018, 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- --
901 901
902 Assoc : Node_Id; 902 Assoc : Node_Id;
903 Choice : Node_Id; 903 Choice : Node_Id;
904 Dim_Aggr : Node_Id; 904 Dim_Aggr : Node_Id;
905 Dim_Symbol : Node_Id; 905 Dim_Symbol : Node_Id;
906 Dim_Symbols : Symbol_Array := No_Symbols; 906 Dim_Symbols : Symbol_Array := No_Symbols;
907 Dim_System : System_Type := Null_System; 907 Dim_System : System_Type := Null_System;
908 Position : Nat := 0; 908 Position : Dimension_Position := Invalid_Position;
909 Unit_Name : Node_Id; 909 Unit_Name : Node_Id;
910 Unit_Names : Name_Array := No_Names; 910 Unit_Names : Name_Array := No_Names;
911 Unit_Symbol : Node_Id; 911 Unit_Symbol : Node_Id;
912 Unit_Symbols : Symbol_Array := No_Symbols; 912 Unit_Symbols : Symbol_Array := No_Symbols;
913 913
914 Errors_Count : Nat; 914 Errors_Count : Nat;
915 -- Errors_Count is a count of errors detected by the compiler so far 915 -- Errors_Count is a count of errors detected by the compiler so far
916 -- just before the extraction of names and symbols in the aggregate 916 -- just before the extraction of names and symbols in the aggregate
917 -- (Step 3). 917 -- (Step 3).
947 -- STEP 3: Name and Symbol extraction 947 -- STEP 3: Name and Symbol extraction
948 948
949 Dim_Aggr := First (Expressions (Aggr)); 949 Dim_Aggr := First (Expressions (Aggr));
950 Errors_Count := Serious_Errors_Detected; 950 Errors_Count := Serious_Errors_Detected;
951 while Present (Dim_Aggr) loop 951 while Present (Dim_Aggr) loop
952 Position := Position + 1; 952 if Position = High_Position_Bound then
953
954 if Position > High_Position_Bound then
955 Error_Msg_N ("too many dimensions in system", Aggr); 953 Error_Msg_N ("too many dimensions in system", Aggr);
956 exit; 954 exit;
957 end if; 955 end if;
956
957 Position := Position + 1;
958 958
959 if Nkind (Dim_Aggr) /= N_Aggregate then 959 if Nkind (Dim_Aggr) /= N_Aggregate then
960 Error_Msg_N ("aggregate expected", Dim_Aggr); 960 Error_Msg_N ("aggregate expected", Dim_Aggr);
961 961
962 else 962 else
1556 -- Comparison cases 1556 -- Comparison cases
1557 1557
1558 -- For relational operations, only dimension checking is 1558 -- For relational operations, only dimension checking is
1559 -- performed (no propagation). If one operand is the result 1559 -- performed (no propagation). If one operand is the result
1560 -- of constant folding the dimensions may have been lost 1560 -- of constant folding the dimensions may have been lost
1561 -- in a tree copy, so assume that pre-analysis has verified 1561 -- in a tree copy, so assume that preanalysis has verified
1562 -- that dimensions are correct. 1562 -- that dimensions are correct.
1563 1563
1564 elsif N_Kind in N_Op_Compare then 1564 elsif N_Kind in N_Op_Compare then
1565 if (L_Has_Dimensions or R_Has_Dimensions) 1565 if (L_Has_Dimensions or R_Has_Dimensions)
1566 and then Dims_Of_L /= Dims_Of_R 1566 and then Dims_Of_L /= Dims_Of_R