diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2008-07-30 17:52:58 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2008-07-30 17:52:58 +0200 |
| commit | 6a4d72a6d9aec655e70fdbdf548c9ed00c0350db (patch) | |
| tree | 73834d6791dd4a6ffb55a7f7466b9fa288ad731b /gcc | |
| parent | 706d74594af2a6d72b160ad214881ba75502ae82 (diff) | |
| download | gcc-6a4d72a6d9aec655e70fdbdf548c9ed00c0350db.zip gcc-6a4d72a6d9aec655e70fdbdf548c9ed00c0350db.tar.gz gcc-6a4d72a6d9aec655e70fdbdf548c9ed00c0350db.tar.bz2 | |
sem_ch8.adb (Analyze_Subprogram_Renaming): When renaming an attribute as a actual in an instance...
2008-07-30 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming): When renaming an attribute
as a actual in an instance, check for a missing attribute to prevent
program_error on an illegal program.
* exp_util.adb (Find_Prim_Op): Rather than Assert (False), raise program
error if primitive is not found, so that exception can be handled
elsewhere on illegal programs.
From-SVN: r138322
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_util.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 57 |
2 files changed, 46 insertions, 21 deletions
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d41a6bc..e4b4389 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1581,7 +1581,10 @@ package body Exp_Util is or else Etype (First_Entity (Op)) = Etype (Last_Entity (Op))); Next_Elmt (Prim); - pragma Assert (Present (Prim)); + + if No (Prim) then + raise Program_Error; + end if; end loop; return Node (Prim); @@ -1608,7 +1611,10 @@ package body Exp_Util is Prim := First_Elmt (Primitive_Operations (Typ)); while not Is_TSS (Node (Prim), Name) loop Next_Elmt (Prim); - pragma Assert (Present (Prim)); + + if No (Prim) then + raise Program_Error; + end if; end loop; return Node (Prim); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c5edce6d..6a544c0 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1578,25 +1578,44 @@ package body Sem_Ch8 is -- an abstract formal subprogram must be dispatching -- operation). - case Attribute_Name (Nam) is - when Name_Input => - Stream_Prim := - Find_Prim_Op (Prefix_Type, TSS_Stream_Input); - when Name_Output => - Stream_Prim := - Find_Prim_Op (Prefix_Type, TSS_Stream_Output); - when Name_Read => - Stream_Prim := - Find_Prim_Op (Prefix_Type, TSS_Stream_Read); - when Name_Write => - Stream_Prim := - Find_Prim_Op (Prefix_Type, TSS_Stream_Write); - when others => - Error_Msg_N - ("attribute must be a primitive dispatching operation", - Nam); - return; - end case; + begin + case Attribute_Name (Nam) is + when Name_Input => + Stream_Prim := + Find_Prim_Op (Prefix_Type, TSS_Stream_Input); + when Name_Output => + Stream_Prim := + Find_Prim_Op (Prefix_Type, TSS_Stream_Output); + when Name_Read => + Stream_Prim := + Find_Prim_Op (Prefix_Type, TSS_Stream_Read); + when Name_Write => + Stream_Prim := + Find_Prim_Op (Prefix_Type, TSS_Stream_Write); + when others => + Error_Msg_N + ("attribute must be a primitive" + & " dispatching operation", Nam); + return; + end case; + exception + + -- If no operation was found, and the type is limited, + -- the user should have defined one. + + when Program_Error => + if Is_Limited_Type (Prefix_Type) then + Error_Msg_NE + ("stream operation not defined for type&", + N, Prefix_Type); + return; + + -- Otherwise, compiler should have generated default. + + else + raise; + end if; + end; -- Rewrite the attribute into the name of its corresponding -- primitive dispatching subprogram. We can then proceed with |