aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2020-11-24 00:31:49 +0100
committerPierre-Marie de Rodat <derodat@adacore.com>2020-12-15 06:41:53 -0500
commitafed612dc569a353dc08181446b026c6a6953f19 (patch)
treeb29c101dea1913dfe1a460a30d4c43986aa6f609
parentce20ff0260c24c3da9012e4226e9eb04d01a5221 (diff)
downloadgcc-afed612dc569a353dc08181446b026c6a6953f19.zip
gcc-afed612dc569a353dc08181446b026c6a6953f19.tar.gz
gcc-afed612dc569a353dc08181446b026c6a6953f19.tar.bz2
[Ada] Refactor repeated code for Callable and Terminated attributes
gcc/ada/ * sem_attr.adb (Analyze_Attribute): Merge identical code for Callable and Terminated attributes; refactor calls to Set_Etype occurring in both THEN and ELSE branches of an IF statement for attribute Storage_Size.
-rw-r--r--gcc/ada/sem_attr.adb13
1 files changed, 6 insertions, 7 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 285b260..865bbae 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3351,7 +3351,9 @@ package body Sem_Attr is
-- Callable --
--------------
- when Attribute_Callable =>
+ when Attribute_Callable
+ | Attribute_Terminated
+ =>
Check_E0;
Set_Etype (N, Standard_Boolean);
Check_Task_Prefix;
@@ -6121,6 +6123,8 @@ package body Sem_Attr is
Check_Restriction (No_Obsolescent_Features, P);
elsif Is_Access_Type (P_Type) then
+ Set_Etype (N, Universal_Integer);
+
if Ekind (P_Type) = E_Access_Subprogram_Type then
Error_Attr_P
("cannot use % attribute for access-to-subprogram type");
@@ -6130,7 +6134,6 @@ package body Sem_Attr is
and then Is_Type (Entity (P))
then
Check_Type;
- Set_Etype (N, Universal_Integer);
-- Validate_Remote_Access_To_Class_Wide_Type for attribute
-- Storage_Size since this attribute is not defined for
@@ -6143,7 +6146,6 @@ package body Sem_Attr is
else
Check_Task_Prefix;
- Set_Etype (N, Universal_Integer);
end if;
else
@@ -6294,10 +6296,7 @@ package body Sem_Attr is
-- Terminated --
----------------
- when Attribute_Terminated =>
- Check_E0;
- Set_Etype (N, Standard_Boolean);
- Check_Task_Prefix;
+ -- Shares processing with Callable attribute
----------------
-- To_Address --