diff options
| author | Bob Duff <duff@adacore.com> | 2015-05-22 10:36:56 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2015-05-22 12:36:56 +0200 |
| commit | ca811241793e95b1c7be841dda57e459dd03b2eb (patch) | |
| tree | 649f3ba91b6b3b3ce8a2e5c37a6b94d090f1caf1 /gcc/ada/sem_ch8.adb | |
| parent | a95f708ec32470ae773950928c3fb1962d0ec86e (diff) | |
| download | gcc-ca811241793e95b1c7be841dda57e459dd03b2eb.tar.gz | |
exp_utils.ads, [...] (Find_Optional_Prim_Op): New interface to return Empty when not found...
2015-05-22 Bob Duff <duff@adacore.com>
* exp_utils.ads, exp_utils.adb (Find_Optional_Prim_Op): New
interface to return Empty when not found, so we can avoid handling
Program_Error in that case.
(Find_Prim_Op): Fix latent bug: raise Program_Error when there are no
primitives.
* exp_ch7.adb, sem_util.adb: Use Find_Optional_Prim_Op when the
code is expecting Empty.
* sem_ch8.adb: Use Find_Optional_Prim_Op to avoid handling
Program_Error.
From-SVN: r223541
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 67 |
1 files changed, 32 insertions, 35 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c1c40bc59aa..d3784f8589c 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2639,45 +2639,42 @@ package body Sem_Ch8 is -- an abstract formal subprogram must be dispatching -- operation). - 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 + case Attribute_Name (Nam) is + when Name_Input => + Stream_Prim := + Find_Optional_Prim_Op (Prefix_Type, TSS_Stream_Input); + when Name_Output => + Stream_Prim := + Find_Optional_Prim_Op (Prefix_Type, TSS_Stream_Output); + when Name_Read => + Stream_Prim := + Find_Optional_Prim_Op (Prefix_Type, TSS_Stream_Read); + when Name_Write => + Stream_Prim := + Find_Optional_Prim_Op (Prefix_Type, TSS_Stream_Write); + when others => + Error_Msg_N + ("attribute must be a primitive" + & " dispatching operation", Nam); + return; + end case; - -- If no operation was found, and the type is limited, - -- the user should have defined one. + -- 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; + if No (Stream_Prim) then + 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 + -- Otherwise, compiler should have generated default - else - raise; - end if; - end; + else + raise Program_Error; + end if; + end if; -- Rewrite the attribute into the name of its corresponding -- primitive dispatching subprogram. We can then proceed with |