aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2014-01-04 11:20:24 +0100
committerTristan Gingold <tgingold@free.fr>2014-01-04 11:20:24 +0100
commit071b3291e88f05bc06d91fe4ebe88582292d3f0d (patch)
tree9cad198d401c6aa8db4d7cc7912cd577c6457f64
parent1c91baed947d3db1f9141a8fec77b644cf0a29f9 (diff)
downloadghdl-071b3291e88f05bc06d91fe4ebe88582292d3f0d.tar.gz
ghdl-071b3291e88f05bc06d91fe4ebe88582292d3f0d.tar.bz2
ghdl-071b3291e88f05bc06d91fe4ebe88582292d3f0d.zip
Fix various minor bugs: alias of access type, subprograms in entity, active
attribute in sensitivity list, missing dependence, and block_statement in expanded name.
-rw-r--r--canon.adb3
-rw-r--r--sem.adb1
-rw-r--r--sem.ads2
-rw-r--r--sem_names.adb3
-rw-r--r--translate/trans_be.adb3
-rw-r--r--translate/translation.adb49
6 files changed, 43 insertions, 18 deletions
diff --git a/canon.adb b/canon.adb
index 58136a5ec..f43bc37a2 100644
--- a/canon.adb
+++ b/canon.adb
@@ -190,7 +190,8 @@ package body Canon is
when Iir_Kinds_Type_Attribute =>
null;
- when Iir_Kind_Event_Attribute =>
+ when Iir_Kind_Event_Attribute
+ | Iir_Kind_Active_Attribute =>
-- LRM 8.1
-- An attribute name: [...]; otherwise, apply this rule to the
-- prefix of the attribute name.
diff --git a/sem.adb b/sem.adb
index 5dca80082..be97ac6c3 100644
--- a/sem.adb
+++ b/sem.adb
@@ -2309,6 +2309,7 @@ package body Sem is
return;
end if;
Libraries.Load_Design_Unit (Prefix_Name, Clause);
+ Add_Dependence (Prefix_Name);
when others =>
Error_Msg_Sem ("prefix must designate a package or a library",
Prefix);
diff --git a/sem.ads b/sem.ads
index e7da46d50..a6a6942ee 100644
--- a/sem.ads
+++ b/sem.ads
@@ -30,7 +30,7 @@ package Sem is
function Get_Current_Design_Unit return Iir_Design_Unit;
-- Makes the current design unit depends on UNIT.
- -- UNIT must be either an entit_aspect or a design_unit.
+ -- UNIT must be either an entity_aspect or a design_unit.
procedure Add_Dependence (Unit : Iir);
-- Add EL in the current design unit list of items to be checked later.
diff --git a/sem_names.adb b/sem_names.adb
index f7a28a579..f56dabcb6 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -1229,6 +1229,9 @@ package body Sem_Names is
case Get_Kind (Res) is
when Iir_Kind_Design_Unit =>
return;
+ when Iir_Kind_Block_Statement =>
+ -- Part of an expanded name
+ return;
when Iir_Kinds_Object_Declaration
| Iir_Kind_Attribute_Value
| Iir_Kind_Type_Declaration
diff --git a/translate/trans_be.adb b/translate/trans_be.adb
index 0725fb727..80b468996 100644
--- a/translate/trans_be.adb
+++ b/translate/trans_be.adb
@@ -118,9 +118,6 @@ package body Trans_Be is
if not Main then
-- Main units (those from the analyzed design file) are translated
-- directly by ortho_front.
- if Flags.Verbose then
- Put_Line ("translate " & Disp_Node (Lib));
- end if;
Translation.Translate (Unit, Main);
diff --git a/translate/translation.adb b/translate/translation.adb
index 8acbc7bef..7ed526cd7 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -3978,8 +3978,11 @@ package body Translation is
Rtis.Generate_Unit (Entity);
end if;
- if Global_Storage /= O_Storage_External then
- -- Entity process subprograms.
+ if Global_Storage = O_Storage_External then
+ -- Entity declaration subprograms.
+ Chap4.Translate_Declaration_Chain_Subprograms (Entity, Entity);
+ else
+ -- Entity declaration and process subprograms.
Chap9.Translate_Block_Subprograms (Entity, Entity);
-- Elaborator Body.
@@ -10321,7 +10324,9 @@ package body Translation is
-- check for matching bounds.
Atype := Get_Ortho_Type (Decl_Type, Info.Alias_Kind);
when Type_Mode_Array
- | Type_Mode_Ptr_Array =>
+ | Type_Mode_Ptr_Array
+ | Type_Mode_Acc
+ | Type_Mode_Fat_Acc =>
-- Create an object pointer.
-- At elaboration: copy base from name.
Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind);
@@ -10386,6 +10391,10 @@ package body Translation is
Name_Type, Name_Node,
Decl);
Close_Temp;
+ when Type_Mode_Acc
+ | Type_Mode_Fat_Acc =>
+ New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var),
+ M2Addr (Name_Node));
when Type_Mode_Scalar =>
case Alias_Info.Alias_Kind is
when Mode_Value =>
@@ -10965,8 +10974,13 @@ package body Translation is
end if;
when Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body =>
- if not Flag_Discard_Unused
- or else Get_Use_Flag (Get_Subprogram_Specification (El))
+ -- Do not translate body if generating only specs (for
+ -- subprograms in an entity).
+ if Global_Storage /= O_Storage_External
+ and then
+ (not Flag_Discard_Unused
+ or else
+ Get_Use_Flag (Get_Subprogram_Specification (El)))
then
Chap2.Translate_Subprogram_Body (El);
Translate_Resolution_Function_Body
@@ -13258,7 +13272,10 @@ package body Translation is
return Get_Var (Name_Info.Alias_Var, Type_Info,
Name_Info.Alias_Kind);
when Type_Mode_Ptr_Array
- | Type_Mode_Array =>
+ | Type_Mode_Array
+ | Type_Mode_Record
+ | Type_Mode_Acc
+ | Type_Mode_Fat_Acc =>
R := Get_Var (Name_Info.Alias_Var);
return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
when Type_Mode_Scalar =>
@@ -13268,9 +13285,6 @@ package body Translation is
else
return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
end if;
- when Type_Mode_Record =>
- R := Get_Var (Name_Info.Alias_Var);
- return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
when others =>
raise Internal_Error;
end case;
@@ -15862,6 +15876,9 @@ package body Translation is
return Translate_Fat_Array_Type_Conversion
(Expr, Expr_Type, Res_Type, Loc);
end if;
+ when Iir_Kind_Record_Type_Definition
+ | Iir_Kind_Record_Subtype_Definition =>
+ return Expr;
when others =>
Error_Kind ("translate_type_conversion", Res_Type);
end case;
@@ -27591,9 +27608,7 @@ package body Translation is
O_Storage_External, Ghdl_Rtin_Block);
case Get_Kind (Lib_Unit) is
when Iir_Kind_Entity_Declaration
- | Iir_Kind_Architecture_Declaration =>
- Info.Block_Rti_Const := Rti;
- when Iir_Kind_Package_Declaration =>
+ | Iir_Kind_Package_Declaration =>
declare
Prev : Rti_Block;
begin
@@ -27601,8 +27616,16 @@ package body Translation is
Generate_Declaration_Chain
(Get_Declaration_Chain (Lib_Unit));
Pop_Rti_Node (Prev);
- Info.Package_Rti_Const := Rti;
end;
+ when others =>
+ null;
+ end case;
+ case Get_Kind (Lib_Unit) is
+ when Iir_Kind_Entity_Declaration
+ | Iir_Kind_Architecture_Declaration =>
+ Info.Block_Rti_Const := Rti;
+ when Iir_Kind_Package_Declaration =>
+ Info.Package_Rti_Const := Rti;
when Iir_Kind_Package_Body =>
-- Replace package declaration RTI with the body one.
Get_Info (Get_Package (Lib_Unit)).Package_Rti_Const := Rti;